View Single Post
 
Old 11-30-2018, 02:53 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,142
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote