VBA to find/replace a character in string and remove text before or after select character

[tinderbox22]

Hello.

I'm attempting to write code that will copy and insert-down rows of data based on however many times a "," appears in a string.
I've already written a succesful 'Do Until' loop that copies and inserts down. I now need to go back to the newly inserted data and remove text before or after said ",".

Simplified Original data looks like this:

Column D:
D2: 300, 200, 100
D3: 400, 100
D5: 500
D6: 100, 300

My loop will copy that row and insert directly below each row the appropriate number of times based on the comma count. So, once that loop runs, updated data looks like this:

D2: 300, 200, 100
D3: 300, 200, 100
D4: 300, 200, 100
D5: 400, 100
D6: 400, 100
D7: 500
D8: 100, 300
D9: 100, 300

All's great so far. Now, here's where I'm stuck. What is the best way to get my new data to look like this:

D2: 300
D3: 200
D4: 100
D5: 400
D6: 100
D7: 500
D8: 100
D9: 300

I'm assuming I would need to find each instance of the comma within each row and then replace all text either before or after depending on where the comma sits, but that's where I get stuck.

Any and all help is greatly appreciated.

Thank you!

 

[gallen]

Hello, this will tidy up and keep all text before the first instance of a comma:

Sub TidyUp()
    Dim lPos As Long 'position of first comma
    Dim lr As Long 'last row in column D
    
    Dim c As Range
    
    lr = Range("D" & Rows.Count).End(xlUp).Row
    
    For Each c In Range(Cells(2, "D"), Cells(lr, "D"))
        lPos = InStr(1, c, ",")
        If lPos > 0 Then
            Application.EnableEvents = False
            c = Mid(c, 1, lPos - 1)
            Application.EnableEvents = True
        End If
    Next c
End Sub

 

[Fluff]

How about

Sub tinderbox()
   Dim i As Long, j As Long
   Dim sp As Variant
   
   For i = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
      sp = Split(Cells(i, 4), ", ")
      Cells(i, 4) = sp(0)
      For j = 1 To UBound(sp)
         Rows(i).Copy
         Rows(i + j).Insert
         Cells(i + j, 4).Value = sp(j)
      Next j
   Next i
   Application.CutCopyMode = False
End Sub

 

[tinderbox22]

How about

Sub tinderbox()
   Dim i As Long, j As Long
   Dim sp As Variant
   
   For i = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
      sp = Split(Cells(i, 4), ", ")
      Cells(i, 4) = sp(0)
      For j = 1 To UBound(sp)
         Rows(i).Copy
         Rows(i + j).Insert
         Cells(i + j, 4).Value = sp(j)
      Next j
   Next i
   Application.CutCopyMode = False
End Sub

Thank you! This worked great. Very simple to follow and understand. I wasn't familiar with the Split function, and that's what I was missing.
Curious if there's an advantage or a necessity to using 'Step -1' versus starting with i = 2 and ending with the end of the rows.count?

 

[Fluff]

Whenever inserting/deleting rows, it's normally better to work up rather than down.