Splitting and replacing delimited strings into new rows using VBA in 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

tigeravatar · Accepted Answer · 2018-04-19 19:08:54Z

3

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

edited Apr 19, 2018 at 19:08

answered Apr 19, 2018 at 17:35

tigeravatar

26.7k5 gold badges32 silver badges42 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

KWusf Over a year ago

It actually doesn't seem to work if column B has an initial blank value. It will skip to the next populated row.

Ron Rosenfeld · Accepted Answer · 2018-04-20 00:54:22Z

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"

Storax · Accepted Answer · 2018-04-19 17:49:06Z

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

user4039065 · Accepted Answer · 2018-04-19 18:01:11Z

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

Collectives™ on Stack Overflow

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

4 Answers 4

1 Comment

Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

1 Comment

Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related