Splitting and replacing delimited strings into new rows using VBA in Excel - excel

Question

I have data in 2 columns. The data in column B is comma delimited. I need each instance to appear on a new row while retaining it's original ID from column A. I also need the data in 3 columns so Name is in B and Number in C. It appears as so:
A--------B
1--------Sam Jones, 1 hours, Chris Bacon, 2 hours
2--------John Jacob, 3 hours
3--------John Hancock, 4 hours, Brian Smith, .5 hours
I am able to get it as such using my code below:
A--------B
1--------Sam Jones, 1
1--------Chris Bacon, 2 hours
2--------John Jacob, 3 hours
3--------John Hancock, 4
3--------Brian Smith, .5 hours
I need it to be: (notice last value in string also has hours removed when added to new line)
A---------B------------------------C
1---------Sam Jones-----------1
1---------Chris Bacon----------2
2---------John Jacob-----------3
3---------John Hancock-------4
3---------Brian Smith----------.5
I have the following code started: (I can't manage to remove the "hours" from the last person in each delimited string and I can't get it into 3 columns)
Sub splitByColB()
Dim r As Range, i As Long, ar
Set r = Worksheets("Sheet1").Range("B2").End(xlDown)
Do While r.Row > 1
ar = Split(r.Value, " hours, ")
If UBound(ar) >= 0 Then r.Value = ar(0)
For i = UBound(ar) To 1 Step -1
r.EntireRow.Copy
r.Offset(1).EntireRow.Insert
r.Offset(1).Value = ar(i)
Next
Set r = r.Offset(-1)
Loop
End Sub

Answer 1

Something like this is what you're looking for:
Sub tgr()
Dim ws As Worksheet
Dim aData As Variant
Dim aTemp As Variant
Dim aResults(1 To 65000, 1 To 3) As Variant
Dim ResultIndex As Long
Dim i As Long, j As Long
Set ws = ActiveWorkbook.Sheets("Sheet1")
With ws.Range("B2", ws.Cells(ws.Rows.Count, "B").End(xlUp))
If .Row < 2 Then Exit Sub 'No data
aData = .Offset(, -1).Resize(, 2).Value
End With
For i = LBound(aData, 1) To UBound(aData, 1)
If Len(Trim(aData(i, 2))) = 0 Then
ResultIndex = ResultIndex + 1
aResults(ResultIndex, 1) = aData(i, 1)
Else
aTemp = Split(aData(i, 2), ",")
For j = LBound(aTemp) To UBound(aTemp) Step 2
ResultIndex = ResultIndex + 1
aResults(ResultIndex, 1) = aData(i, 1)
aResults(ResultIndex, 2) = Trim(aTemp(j))
aResults(ResultIndex, 3) = Trim(Replace(aTemp(j + 1), "hours", vbNullString, , , vbTextCompare))
Next j
End If
Next i
ws.Range("A2").Resize(ResultIndex, UBound(aResults, 2)).Value = aResults
End Sub

Answer 2

You can use Power Query. It is a free MS add-in in 2010, 2013 and included in 2016 where it is called Get & Transform
Split column 2 by delimiter custom --> hours,
Select the ID column and unpivot other columns
Select column 2 and split by delimiter = comma
Remove unnecessary column
Replace value "hours"
And if you add to the table, you can re-run the query
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"ID", Int64.Type}, {"Data", type text}}),
#"Split Column by Delimiter" = Table.SplitColumn(#"Changed Type", "Data", Splitter.SplitTextByDelimiter("hours,", QuoteStyle.Csv), {"Data.1", "Data.2"}),
#"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Data.1", type text}, {"Data.2", type text}}),
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type1", {"ID"}, "Attribute", "Value"),
#"Split Column by Delimiter1" = Table.SplitColumn(#"Unpivoted Other Columns", "Value", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Value.1", "Value.2"}),
#"Changed Type2" = Table.TransformColumnTypes(#"Split Column by Delimiter1",{{"Value.1", type text}, {"Value.2", type text}}),
#"Removed Columns" = Table.RemoveColumns(#"Changed Type2",{"Attribute"}),
#"Replaced Value" = Table.ReplaceValue(#"Removed Columns","hours","",Replacer.ReplaceText,{"Value.2"})
in
#"Replaced Value"

Answer 3

I would use a class with the name data
Option Explicit
Public Id As String
Public FullName As String
Public hours As String
and the following code
Option Explicit
Sub SplitIt()
Dim rg As Range
Dim col As New Collection
Dim dataLine As data
Set rg = Worksheets("Sheet1").Range("A1").CurrentRegion
Dim vDat As Variant
vDat = rg.Columns
Dim lDat As Variant
Dim i As Long, j As Long
For i = LBound(vDat) To UBound(vDat)
lDat = Split(vDat(i, 2), ",")
For j = LBound(lDat) To UBound(lDat) Step 2
Dim hDat As Variant
hDat = Split(Trim(lDat(j + 1)), " ")
Set dataLine = New data
dataLine.Id = vDat(i, 1)
dataLine.FullName = Trim(lDat(j))
dataLine.hours = hDat(0)
col.Add dataLine
Next j
Next i
' Print Out
For i = 1 To col.Count
Set dataLine = col(i)
rg.Cells(i, 1) = dataLine.Id
rg.Cells(i, 2) = dataLine.FullName
rg.Cells(i, 3) = dataLine.hours
Next i
End Sub

Answer 4

Why not split on hours to a) add a record delimiter and b) get rid of hours?
Option Explicit
Sub splitByColB()
Dim r As Long, i As Long, hrs As Variant, cms As Variant
With Worksheets("sheet1")
For r = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
hrs = Split(.Cells(r, "B").Value2 & ", ", " hours, ")
ReDim Preserve hrs(UBound(hrs) - 1)
If CBool(UBound(hrs)) Then _
.Cells(r, "A").Offset(1, 0).Resize(UBound(hrs), 1).EntireRow.Insert
For i = UBound(hrs) To LBound(hrs) Step -1
cms = Split(hrs(i), ", ")
.Cells(r, "A").Offset(i, 0) = .Cells(r, "A").Value
.Cells(r, "A").Offset(i, 1) = cms(0)
.Cells(r, "A").Offset(i, 2) = cms(1)
Next i
Next r
End With
End Sub