VBA split References by comma delimited

[decadence]

Hi, I am trying to expand references by comma delimited but not sure how. can someone help with this please

Example:

From This:


[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD][/TD]
[TD]References
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A3, A7, A10-A15, A17, A19
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]B12-18, B20
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]C01-C09
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]D01,D04,D08,D013-016
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


To This:


[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD][/TD]
[TD]References
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A3,A7,A10,A11,A12,A13,A14,A15,A17,A19
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]B12,B13,B14,B15,B16,B17,B18,B20
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]C1,C2,C3,C4,C5,C6,C7,C8,C9
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]D1,D4,D8,D13,D14,D15,D16
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Kyle123]

Couple of questions:

1. Are they already in order?
2. How good is the data, i.e are there any overlaps in the cell?

 

[decadence]

Hi Kyle123, No they are not necessarily going to be in order and what is in the example with vary in length

 

[Kyle123]

Do they need to be in order?

What about my second question?

So is "A13, A10-A14" possible and what should the outcome be?

 

[Kyle123]

Assuming that there will be no overlapping ranges, try this: (probably as a worksheet formula)

Option Explicit

Public Function Expand(st As String) As String

    Const delim     As String = ","
    Static regex    As Object, al As Object
    Dim x           As Long
    Dim y           As Long
    Dim letter      As String
    Dim sla, nu, nus
    
    
    If regex Is Nothing Then Set regex = CreateObject("vbscript.regexp")
    Set al = CreateObject("system.collections.arraylist")
    
    letter = Left(st, 1)
    regex.Pattern = "[A-Z]"
    regex.Global = True
    st = regex.Replace(st, "")

    sla = Split(Replace(st, " ", ""), delim)
    
    
    For x = LBound(sla) To UBound(sla)
        If InStr(1, sla(x), "-") > 0 Then
            nus = Split(sla(x), "-")
            For y = Val(nus(0)) To Val(nus(1))
                al.Add CLng(y)
            Next y
        Else
            al.Add CLng(Val(sla(x)))
        End If
        
    Next x
    
    al.Sort
    
    Expand = letter & Join(al.toarray, delim & letter)
    

End Function

Sub test()
    Debug.Print Expand("A3, A7, A10-A15, A17, A19") = "A3,A7,A10,A11,A12,A13,A14,A15,A17,A19"
    Debug.Print Expand("B12-18, B20") = "B12,B13,B14,B15,B16,B17,B18,B20"
    Debug.Print Expand("C01-C09") = "C1,C2,C3,C4,C5,C6,C7,C8,C9"
    Debug.Print Expand("D01,D04,D08,D013-016") = "D1,D4,D8,D13,D14,D15,D16"
    Debug.Print Expand("D01") = "D1"
End Sub

 

[Kyle123]

This is better:

Public Function Expand(st As String) As String

    Const delim     As String = ","
    
    Dim al          As Object
    Dim x           As Long
    Dim y           As Long
    Dim letter      As String
    Dim sla         As Variant
    Dim nus         As Variant
    
    Set al = CreateObject("system.collections.arraylist")
    
    letter = Left(st, 1)
    st = Replace(st, letter, "")
    
    'Trailing delim will add an additional element to the output
    If Right(st, 1) = delim Then st = Left(st, Len(st) - 1)

    sla = Split(Replace(st, " ", ""), delim)
    
    For x = LBound(sla) To UBound(sla)
        If InStr(1, sla(x), "-") > 0 Then
            nus = Split(sla(x), "-")
            For y = Val(nus(0)) To Val(nus(1))
                al.Add CLng(y)
            Next y
        Else
            al.Add CLng(Val(sla(x)))
        End If
        
    Next x
    
    al.Sort
    
    Expand = letter & Join(al.toarray, delim & letter)
    
End Function

 

[decadence]

Hi kyle123, I have tried both and it skips on this line when stepping through

For x = LBound(sla) To UBound(sla)

then jumps straight to

al.Sort

I am calling it from a sub like this

Sub ExpandRefs()
    Dim x As range, Rng As range, c As String
    
    Set Rng = Selection
    
    For Each x In Rng
        x = Expand(c)
    Next x
    
End Sub

 

[Kyle123]

Does it work with the test sub in post #5 ? Your sub doesn't make any sense, you aren't passing the function a value.

Why don't you just use it as a worksheet function?

This works fine for me:

Sub ExpandRefs()
    Dim x As Range, Rng As Range
    
    Set Rng = Selection
    
    For Each x In Rng
        x = Expand(x.Value2)
    Next x
    
End Sub

 

[Fluff]

If you want the address of all the cells in the selection, try

Sub ExpandRefs()
    Dim Ar As Areas, Rng As Range, Cl As Range, St As String
    
    Set Ar = Selection.Areas
    
    For Each Rng In Ar
      For Each Cl In Rng
        St = Cl.Address(0, 0) & "," & St
      Next Cl
    Next Rng
    MsgBox St
    
End Sub

 

[decadence]

Thanks for the reply, yes I now realise this Kyle123 thanks for all your help. Thanks Fluff I can use this.