Excel Macro for changing references with numbers separated by a dash into the full set of references

Question

I have been dealing with customer bill of materials that contains references with numbers that are separated by a dash, rather than the full sequence of references spelled out, e.g. C1-4 instead of C1, C2, C3, C4 or C1 C2 C3 C4

Some customers will use a comma to separate references, some only space, sometimes there is a mix of the two, which also complicates things. Here is an example:

   R161-169
 
   R2 R5, R7 R11

   R103-7
   
   R26 R28-30 R42, R45-46, R62-65, R70-71, R92-102, R113-114
   
   R31-35 R40-41 R56-61 R72-79 R86-91
   
   R36, R38-39

I'm trying to make a macro that will generate the full set of references automatically for only the selected portion of the references column, and generate that full set of references in the column next to it.

Sometimes customers leave a blank line between sections of references. Empty cells should remain empty in the output.

I found one place online that had asked a very similar question - https://www.mrexcel.com/board/threads/splitting-out-numbers-separated-by-dash.679290/ but I did not understand the code there and it did not work for what I've been trying to do.

I am not great with VBS, but I got the below code running without throwing any errors so far, but it doesn't generate the full set of references. It just copies them as they are, and I do not know where I went wrong.

Sub SplitReferences()
'June 1, 2023
Dim inputRange As Range
Dim outputCell As Range
Dim inputArea As Range
Dim inputCell As Range
Dim startNum As Long
Dim endNum As Long
Dim i As Long
Dim outputString As String

' Set the input range where your values are
Set inputRange = Selection ' Use the selected range as input

' Set the output range where you want the split references
Set outputCell = inputRange.Offset(0, 1).Cells(1) ' Output in the column next to the input

' Loop through each area in the input range
For Each inputArea In inputRange.Areas
    ' Loop through each cell in the area
    For Each inputCell In inputArea
        ' Split the value by dash
        Dim parts() As String
        parts = Split(inputCell.Value, "-")

        ' Check if there is a dash in the value
        If UBound(parts) > 0 Then
            ' Extract the start and end numbers
            startNum = Val(parts(0))
            endNum = Val(parts(1))
        Else
            ' If there is no dash, treat it as a single value
            startNum = Val(parts(0))
            endNum = Val(parts(0))
        End If

        ' Loop through the numbers and add them to the output range
        For i = startNum To endNum
            outputCell.Value = inputCell.Offset(i - startNum).Value
            Set outputCell = outputCell.Offset(1) ' Move to the next row
        Next i
    Next inputCell
Next inputArea
End Sub

Answer 1

Another approach:

Sub Tester()
    Dim c As Range, arr, el, txt As String, rv As String, sep As String
    
    For Each c In Selection.Cells 'loop selected range
        txt = Trim(c.Value)
        If Len(txt) > 0 Then      'cell has a value?
            arr = Split(Normalize(txt), " ")
            rv = ""
            sep = ""
            For Each el In arr
                'convert to sequence if value has a dash
                If InStr(el, "-") > 0 Then el = Sequence(CStr(el), " ")
                If Len(el) > 0 Then rv = rv & sep & el
                sep = " "
            Next el
            With c.Offset(0, 1)
                .WrapText = True
                .Value = rv
                .EntireRow.AutoFit
            End With
        End If 'has content
    Next c
End Sub

'Normalize the input to replace unwanted characters with spaces
'  Remove runs of >1 space, and spaces around "-"
Function Normalize(ByVal txt As String)
    Dim arr, el
    arr = Array(vbLf, vbCr, Chr(160), ",", ";", ":") 'replace these with a space
    For Each el In arr
        txt = Replace(txt, el, " ")
    Next el
    Do While InStr(1, txt, "  ") > 0  'remove any multi-space runs
        txt = Replace(txt, "  ", " ")
    Loop
    txt = Replace(txt, " -", "-") 'remove any spaces next to dashes
    txt = Replace(txt, "- ", "-")
    Normalize = txt
End Function

'Return a sequence from a pattern like [letter][number1]-[number2],
'  separated by `sep`
Function Sequence(txt As String, sep As String)
    Dim prefix, rv As String, sp, arr, v1, v2, i As Long
    prefix = GetPrefix(txt) 'extract leading non-numeric character(s)
    arr = Split(txt, "-")
    v1 = NumberOnly(arr(0))
    v2 = NumberOnly(arr(1))
    If Len(v1) > 0 And Len(v2) > 0 Then
        'handle case like R102-4, R102-24
        If Len(v2) < Len(v1) Then v2 = Left(v1, Len(v1) - Len(v2)) & v2
        v1 = CLng(v1)
        v2 = CLng(v2)
        For i = v1 To v2 'assumes V2 > v1...
            rv = rv & sp & prefix & i
            sp = sep
        Next i
    End If
    Sequence = rv
End Function

'return the first [whole] number found in `txt`
Function NumberOnly(txt)
    Dim i As Long, c, rv
    For i = 1 To Len(txt)
        c = Mid(txt, i, 1)
        If c Like "#" Then
            NumberOnly = NumberOnly & c
        Else
            If Len(NumberOnly) > 0 Then Exit Function
        End If
    Next i
End Function

'Return leading non-numeric character(s)
Function GetPrefix(txt As String)
    Dim i As Long, c As String, rv
    For i = 1 To Len(txt)
        c = Mid(txt, i, 1)
        If c Like "#" Then Exit For
        rv = rv & c
    Next i
    GetPrefix = rv
End Function