Need macro to expand values

ganesang · #1 11-28-2018, 11:52 PM

Hi Paul

I have the data which needs to be expand up to as mentioned in the word file.

<fir fin=“MP1“/>-<fir fin=“MP17“/> this line needs to be expanded up to MP1-MP17

for example,

<fir fin=“MP1“/>
<fir fin=“MP2“/>
<fir fin=“MP3“/>.......and so on up to <fir fin=“MP17“/>.

I have attached the file for reference the highlighted portions are needs to be expanded up to per (MP?) whatever in the file.

Can you please help me out on this?

Thanks
Ganesan. G

ganesang · #2 11-29-2018, 02:23 AM

Output highlighted and attached here what i am expected....

ganesang · #3 11-29-2018, 09:19 PM

Is this possible in the word?

Can anyone help me out on this?

gmayor · #4 11-29-2018, 09:59 PM

It is certainly possible. Based on your example:

Code:

Sub Macro1()
Dim oRow As Row
Dim oRng As Range
Dim iEnd As Integer, i As Integer
Dim strEnd As String
Dim strText As String, strText2 As String
    For Each oRow In Selection.Tables(1).Rows
        strText = ""
        Set oRng = oRow.Cells(1).Range
        oRng.End = oRng.End - 1
        If InStr(1, oRng.Text, ">-<") > 0 Then
            strEnd = Split(oRng.Text, "-")(1)
            iEnd = NumberFromText(strEnd)
            For i = 1 To iEnd
                strText = strText & Replace(Split(oRng.Text, "-")(0), "1", i)
                If i < iEnd Then strText = strText & Chr(11)
            Next i
            oRng.Text = strText
        End If
    Next oRow
End Sub

Function NumberFromText(sText As String) As Integer
Dim Length_of_String As Integer
Dim iPos As Integer
Dim strNum As String
    Length_of_String = Len(sText)
    For iPos = 1 To Length_of_String
        If (IsNumeric(Mid(sText, iPos, 1))) = True Then
            strNum = strNum & Mid(sText, iPos, 1)
        End If
    Next iPos
    If Len(strNum) = 0 Then
        NumberFromText = 0
    Else
        NumberFromText = CInt(strNum)
    End If
End Function

ganesang · #5 11-29-2018, 10:22 PM

Hi gmayor

Its really a fantastic!!!!

Thanks much again...

Ganesan. G

ganesang · #6 11-29-2018, 10:30 PM

Hi gmayor

Thanks for providing the code.

If i try to run this macro in my file, the following error occurred and some of the instances not expanded.

Error name: "Overflow (Error 6) "

Have you set any limitation set this macro to expand the value. I have large data to change expand the values. I am just given the some of the data's only as a example file.

Please check and let me know.

Thanks

ganesang · #7 11-29-2018, 11:19 PM

Hi gmayor

The problem is some if the numbers start between, for ex., 5-7, 8-25 etc....

The below code only convert from 1 to up to whatever in the file.

Sorry its my fault to mention that the occurrences.

I am just found the below instances too...

<fir fin=“MP5“/>-<fir fin=“MP17“/>,
<fir fin=“MP6“/>-<fir fin=“MP8“/>
<fir fin=“C4“/>-<fir fin=“C7“/> etc...

Please help me out on this too....

gmayor · #8 11-30-2018, 02:53 AM

I can only reply based on the information you provide, however the following should now work with the additional examples.

Code:

Sub Macro1()
'Graham Mayor - https://www.gmayor.com - Last updated - 30 Nov 2018 

Dim oRow As Row
Dim oRng As Range
Dim iStart As Integer, iEnd As Integer, i As Integer
Dim strStart As String, strEnd As String
Dim strText As String, strText2 As String
    On Error GoTo err_Handler
    For Each oRow In Selection.Tables(1).Rows
        strText = ""
        Set oRng = oRow.Cells(1).Range
        oRng.End = oRng.End - 1
        oRng.Text = Replace(oRng.Text, "><", ">-<")
        If InStr(1, oRng.Text, ">-<") > 0 Then
            strStart = Split(oRng.Text, "-")(0)
            iStart = NumberFromText(strStart)
            strEnd = Split(oRng.Text, "-")(1)
            iEnd = NumberFromText(strEnd)
            For i = iStart To iEnd
                strText = strText & Replace(Split(oRng.Text, "-")(0), CStr(iStart), i)
                If i < iEnd Then strText = strText & Chr(11)
            Next i
            oRng.Text = strText
        End If
        DoEvents
    Next oRow
lbl_Exit:
    Set oRng = Nothing
    Set oRow = Nothing
    Exit Sub
err_Handler:
    Err.Clear
    GoTo lbl_Exit
End Sub

Function NumberFromText(sText As String) As Integer
Dim Length_of_String As Integer
Dim iPos As Integer
Dim strNum As String
    On Error GoTo err_Handler
    Length_of_String = Len(sText)
    For iPos = 1 To Length_of_String
        If (IsNumeric(Mid(sText, iPos, 1))) = True Then
            strNum = strNum & Mid(sText, iPos, 1)
        End If
    Next iPos
    If Len(strNum) = 0 Then
        NumberFromText = 0
    Else
        NumberFromText = CInt(strNum)
    End If
lbl_Exit:
    Exit Function
err_Handler:
    NumberFromText = 0
    Err.Clear
    GoTo lbl_Exit
End Function

ganesang · #9 11-30-2018, 02:56 AM

Yes. Its my fault.

This one is awesome as i expected.

Many thanks again!!!!

ganesang · #10 11-30-2018, 03:05 AM

Hi gmayor

Sorry for the inconvenience...

This one is changing all the occurrences like even if its without the hyphens as follows:

<fir fin=“MP5“/><fir fin=“MP7“/>,
<fir fin=“MP6“/><fir fin=“MP7“/> .... they are also in the same rows.

Only needs to be expand hyphenated values and others are needs to be retained.

Please advise.

gmayor · #11 11-30-2018, 04:41 AM

I assumed that the missing hyphens were typos

Remove the line

Code:

oRng.Text = Replace(oRng.Text, "><", ">-<")

ganesang · #12 11-30-2018, 04:50 AM

After removed the above line it's taken off all the contents!!!

gmayor · #13 11-30-2018, 09:54 PM

All that line does is add the hyphen between the >< characters where it was apparently missing. It has no other effect and when removed the macro ignores those lines as requested and works correctly with your example document and the additional examples. Are you sure that was the onloy line you deleted? Copy the code again and simply put an apostrophe at the beginning of the line for the code to ignore it.

ganesang · #14 12-02-2018, 10:17 PM

Hi gmayor

Thanks for the response.

As per the new example,

The numbers needs to be expanded even if its starts with 1 or whatever.

for example., <fir fin=“U3”/>-<fir fin=“U4“/> this line starts with 3 and ended with 4

So, we have to expand this line only from 3-4 and rest of the lines in the same row needs to be retained as it is.

Please refer the new attachment the highlighted items only needs to expanded and rest of them as it is.

As per your new code its being removed the hyphenated lines and retained rest of the lines.

ganesang · #15 12-02-2018, 10:33 PM

Please try the code with this example,

I have tried with and without the line as you ignored it above.

Here i have only expand 18-20 and rest of them as it is.

Please check.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Need macro to fill the values in msword based on the excel sheet info	ganesang	Word VBA	50	08-29-2018 12:53 AM
Table with values from several locations and years - need to find comp values	Ricardo Sousa	Excel	6	06-09-2018 10:51 PM
Macro to Find & Replace Font formats for Multiple Values	GemBox	Word	6	03-12-2018 05:24 AM
Macro to Expand Outline Heading in Outline View?	Clueless in Seattle	Word VBA	1	05-04-2015 05:44 PM
macro to find a character and insert space so autocorrect will expand	redzan	Word VBA	3	05-22-2014 04:22 PM