VBA to split out hyphen strings into comma delimited

[decadence]

Hi, Is it possible to split a hyphen string into comma delimited.

Example:

From This
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]A1-10
[/TD]
[/TR]
[TR]
[TD]J1D1_4-J1D1_7
[/TD]
[/TR]
[TR]
[TD]C2, C4-C8, C12
[/TD]
[/TR]
</tbody>[/TABLE]

To This
[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]A1, A2, A3, A4, A, A, A7, A8, A9, A10
[/TD]
[/TR]
[TR]
[TD]J1D1_4, J1D1_5, J1D1_6, J1D1_7
[/TD]
[/TR]
[TR]
[TD]C2, C4, C5, C6, C7, C8, C12
[/TD]
[/TR]
</tbody>[/TABLE]

 

[Warship]

probably a more elegent solution but try:

Sub SplitHyphenToComma()

    Dim i, element
    Dim rng As Range
    Dim strPrefix As String
    Dim strStartN As String
    Dim strEndNum As String
    Dim strConstr As String
    Dim strSource As String
    Dim arrConstr() As String
    Dim arrSource() As String
    
    For Each rng In Range("A2:A5")
        strSource = rng.Value
        rng.Offset(, 1) = ""
        strConstr = ""
        
        If InStr(strSource, ",") Then
            arrSource = Split(strSource, ",")
            For Each element In arrSource
                If InStr(element, "-") Then
                    arrConstr = Split(element, "-")
                    strStartN = parseInt(arrConstr(0))
                    strPrefix = Replace(arrConstr(0), strStartN, "")
                    strEndNum = parseInt(arrConstr(1))
                    For i = strStartN To strEndNum
                        strConstr = strConstr & ", " & strPrefix & i
                    Next i
                Else
                    strConstr = strConstr & ", " & element
                End If
            Next element
            
        ElseIf InStr(strSource, ",") = 0 And InStr(strSource, "_") = 0 And InStr(strSource, "-") Then
            arrConstr = Split(strSource, "-")
            strStartN = parseInt(arrConstr(0))
            strPrefix = Replace(arrConstr(0), strStartN, "")
            strEndNum = arrConstr(1)
            For i = strStartN To strEndNum
                strConstr = strConstr & ", " & strPrefix & i
            Next i
            
        ElseIf InStr(strSource, "_") Then
            arrSource = Split(strSource, "-")
            arrConstr = Split(arrSource(0), "_")
            strStartN = arrConstr(1)
            strPrefix = arrConstr(0)
            arrConstr = Split(arrSource(1), "_")
            strEndNum = arrConstr(1)
            For i = strStartN To strEndNum
                strConstr = strConstr & ", " & strPrefix & "_" & i
            Next i
        
        End If
        
        rng.Offset(, 1) = WorksheetFunction.Trim(Mid(strConstr, 2))
    Next rng

End Sub

Private Function parseInt(x)
    Dim i As Long, c As String, nums As String
    nums = ""
    For i = 1 To Len(x)
        c = Mid(x, i, 1)
        If IsNumeric(c) Then nums = nums & c
    Next i
    parseInt = nums
End Function

 

[Rick Rothstein]

Here is a UDF that will do what you want...

[table="width: 500"]
[tr]
	[td]Function ExpandedSeries(ByVal S As String, Optional Delimiter As String = ", ") As Variant
  Dim X As Long, Y As Long, Z As Long
  Dim Letter As String, Numbers() As String, Parts() As String
  S = Chr$(1) & Replace(Replace(Replace(Replace(Application.Trim(Replace(S, ",", " ")), " -", "-"), "- ", "-"), " ", " " & Chr$(1)), "-", "-" & Chr$(1))
  Parts = Split(S)
  For X = 0 To UBound(Parts)
    If Parts(X) Like "*-*" Then
      For Z = InStr(Parts(X), "-") - 1 To 1 Step -1
        If Not IsNumeric(Mid(Parts(X), Z, 1)) Then
          Letter = Left(Parts(X), Z)
          Exit For
        End If
      Next
      Numbers = Split(Replace(Parts(X), Letter, ""), "-")
      If Not Numbers(1) Like "*[!0-9" & Chr$(1) & "]*" Then Numbers(1) = Val(Replace(Numbers(1), Chr$(1), "0"))
      On Error GoTo SomethingIsNotRight
      For Z = Numbers(0) To Numbers(1) Step Sgn(-(CLng(Numbers(1)) > CLng(Numbers(0))) - 0.5)
        ExpandedSeries = ExpandedSeries & Delimiter & Letter & Z
      Next
    Else
      ExpandedSeries = ExpandedSeries & Delimiter & Parts(X)
    End If
  Next
  ExpandedSeries = Replace(Mid(ExpandedSeries, Len(Delimiter) + 1), Chr$(1), "")
  Exit Function
SomethingIsNotRight:
  ExpandedSeries = CVErr(xlErrValue)
End Function[/td]
[/tr]
[/table]

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use ExpandedSeries just like it was a built-in Excel function. For example,

=ExpandedSeries(A1)

If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[Peter_SSs]

Hi, Is it possible to split a hyphen string into comma delimited.

Just checking if your sample data is representative.
In rows 2 and 3 the text prefix of any hyphenated part is repeated before and after the hyphen (eg J1D1_4-J1D1_7 and C4-C8). However in the first example the text prefix ("A") is not repeated before and after the hyphen (A1-10)
Is that actually correct?

 

[Warship]

probably a more elegent solution but try:

and here it is!

 

[decadence]

Hi peter,yes that is correct

 

[decadence]

Thank you rick and warship

 

[Peter_SSs]

Hi peter,yes that is correct

Thanks for the clarification. If the suffix numbers are always greater than zero, here is another UDF you could test.

Function Expand(str As String) As String
    Dim pref As String
    Dim itm As Variant
    
    pref = StrReverse(Replace(StrReverse(Split(Replace(str, ",", "-"), "-")(0) & 9), Val(StrReverse(Split(Replace(str, ",", "-"), "-")(0) & 9)), "", 1, 1))
    For Each itm In Split(Replace(Replace(str, pref, ""), " ", ""), ",")
        Expand = Expand & ", " & Join(Application.Transpose(Evaluate("row(" & Split(itm, "-")(0) & ":" & Split(itm & "-" & itm, "-")(1) & ")")), ", ")
    Next itm
    Expand = LTrim(Replace(Mid(Expand, 2), " ", " " & pref))
End Function

Excel Workbook
	A	B
1	A1-10	A1, A2, A3, A4, A5, A6, A7, A8, A9, A10
2	J1D1_4-J1D1_7	J1D1_4, J1D1_5, J1D1_6, J1D1_7
3	C2, C4-C8, C12	C2, C4, C5, C6, C7, C8, C12
Sheet2

 

[decadence]

Hi Peter, Thank you it works perfectly. However I will have to use warships code as I want to keep the cells as a value and the replace the old values with the expanded ones, also data will be in the adjacent column.

 

[Peter_SSs]

That's fine but for the record my function can be used in code just as well as in the worksheet, as Warship did, so keeping my function as is and running this macro would do what you want I believe.

Sub SplitEm()
  Dim a As Variant
  Dim i As Long
  
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      If Len(a(i, 1)) > 0 Then a(i, 1) = Expand(CStr(a(i, 1)))
    Next i
    .Value = a
  End With
End Sub

I also don't know how complex your prefixes could be or how simple your cell values can be, but my code will handle the following cell values whereas the code you are using doesn't I believe.
A19X1-A19X4
CV5