VBA split References by comma delimited

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Hi, I am trying to expand references by comma delimited but not sure how. can someone help with this please

Example:

From This:


References
A3, A7, A10-A15, A17, A19
B12-18, B20
C01-C09
D01,D04,D08,D013-016

<tbody>
</tbody>


To This:


References
A3,A7,A10,A11,A12,A13,A14,A15,A17,A19
B12,B13,B14,B15,B16,B17,B18,B20
C1,C2,C3,C4,C5,C6,C7,C8,C9
D1,D4,D8,D13,D14,D15,D16

<tbody>
</tbody>
 
Last edited:

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Kyle123

Well-known Member
Joined
Jan 24, 2012
Messages
2,708
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

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Hi Kyle123, No they are not necessarily going to be in order and what is in the example with vary in length
 

Kyle123

Well-known Member
Joined
Jan 24, 2012
Messages
2,708
Do they need to be in order?

What about my second question?

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

Kyle123

Well-known Member
Joined
Jan 24, 2012
Messages
2,708

ADVERTISEMENT

Assuming that there will be no overlapping ranges, try this: (probably as a worksheet formula)
Rich (BB code):
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
 
Last edited:

Kyle123

Well-known Member
Joined
Jan 24, 2012
Messages
2,708
This is better:
Rich (BB code):
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
 
Last edited:

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows

ADVERTISEMENT

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

I am calling it from a sub like this

Code:
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
 
Last edited:

Kyle123

Well-known Member
Joined
Jan 24, 2012
Messages
2,708
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:
Rich (BB code):
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
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,655
Office Version
  1. 365
Platform
  1. Windows
If you want the address of all the cells in the selection, try
Code:
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

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Thanks for the reply, yes I now realise this Kyle123 thanks for all your help. Thanks Fluff I can use this.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,533
Messages
5,529,397
Members
409,870
Latest member
Well59
Top