Split cells in a list to create a longer list

[richardallen]

Grateful with some help on a vba task. I am looking to use convert this list:

ABC21256/03/04
ABC21311/01/09/11
ABC21313/02
ABC21378/07/08/31

into to this list:

ABC21256/03
ABC21256/04
ABC21311/01
ABC21311/09
ABC21311/11
ABC21313/02
ABC21378/07
ABC21378/08
ABC21378/31

i.e. each line is split after the "/" and concatenated with the starting string (before the first "/") to create a new sequence and put on separate rows.

 

[sheetspread]

You can split with text to columns and apply the reverse pivot table:

https://vimeo.com/173284995

then reconcat by formula

 

[lrobbo314]

This code will do it. It assumes that your data begins in cell A1, and it outputs the list to column D.

Sub SplitEm()
Dim AR()
Dim SP() As String
Dim LR As Long
Dim r As Range
Dim col As New Collection


LR = Range("A" & Rows.Count).End(xlUp).Row()
Set r = Range("A1:A" & LR)
AR() = r.Value


For i = 1 To UBound(AR)
    SP = Split(AR(i, 1), "/")
    For j = 1 To UBound(SP)
        col.Add SP(0) & "/" & SP(j)
    Next j
Next i


For k = 1 To col.Count
    Cells(k, 4).Value = col.Item(k)
Next k


End Sub

 

[richardallen]

Amazing, thanks. Not familiar with this code. Would you be able to explain how this works?

 

[lrobbo314]

Sure. I've commented the lines of code to try and explain how it works. You can always step through each line of code by hitting F8 in the VB Editor and use the 'Locals' window to observe what is happening to all of your variables. Let me know if you have any other questions and I'd be happy to explain. Here is the commented code.

Sub SplitEm()
Dim AR()
Dim SP() As String
Dim LR As Long
Dim r As Range
Dim col As New Collection




LR = Range("A" & Rows.Count).End(xlUp).Row() 'Get last row in column A
Set r = Range("A1:A" & LR) 'Use LR variable to set range = where your data is
AR() = r.Value 'Fill array with values from range




For i = 1 To UBound(AR) 'Loop through array
    SP = Split(AR(i, 1), "/") 'Use temporary array, SP(), to split each value in AR with the '/' delimiter
    For j = 1 To UBound(SP) 'Loop through SP array from 1 to last item in array
        col.Add SP(0) & "/" & SP(j) 'Add the first item in the array & each split value from SP to a collection object
    Next j
Next i




For k = 1 To col.Count 'Loop through each item in collection
    Cells(k, 4).Value = col.Item(k) 'Output values from the collection to the worksheet
Next k




End Sub

 

[Rick Rothstein]

It would take too long to explain the following code in detail, but I thought you (or future readers of this thread) would find it interesting that a macro can be written that uses no loops... the only restriction is that there cannot be more than 65,535 rows of data total. Note that I sent the output to Column B, but it could be changed to replace the existing data by changing the B1 in the last line of code to A1.

[table="width: 500"]
[tr]
	[td]Sub SplitOnSlashes()
  Dim Addr As String, Arr As Variant
  Addr = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Address
  Arr = Split(Mid(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",SUBSTITUTE(MID(@,FIND(""/"",@),LEN(@)),""/"",""-""&LEFT(@,FIND(""/"",@)-1)&""/""))", "@", Addr))), ""), 2), "-")
  Range("B1").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
End Sub
[/td]
[/tr]
[/table]

 

[richardallen]

Great. Many thanks to you both.

 

[richardallen]

Sure. I've commented the lines of code to try and explain how it works. You can always step through each line of code by hitting F8 in the VB Editor and use the 'Locals' window to observe what is happening to all of your variables. Let me know if you have any other questions and I'd be happy to explain. Here is the commented code.

What would I change to have the data lists start from row 2 (so I can add titles for the user)?

Thanks,
Richard

 

[lrobbo314]

Sub SplitEm()
Dim AR()
Dim SP() As String
Dim LR As Long
Dim r As Range
Dim col As New Collection


LR = Range("A" & Rows.Count).End(xlUp).Row()
Set r = Range("A2:A" & LR) 'Changed to start in A2 instead of A1
AR() = r.Value


For i = 1 To UBound(AR)
    SP = Split(AR(i, 1), "/")
    For j = 1 To UBound(SP)
        col.Add SP(0) & "/" & SP(j)
    Next j
Next i


For k = 1 To col.Count
    Cells(k+1, 4).Value = col.Item(k) 'Changed to 'k+1' to begin outputting in row 2.
Next k


End Sub

 

[richardallen]

Brilliant, thanks. Finally, what would the code be to reverse this? i.e. reassemble a dis-aggregated list:

From:
ABC21256/03
ABC21256/04
ABC21311/01
ABC21311/09
ABC21311/11

To:
ABC21256/03/04
ABC21311/01/09/11