Split ID and Name into multiple rows

[Rudi]

This one has me...
I'm not sure how to break the data at the comma and insert into relevant rows...

Any guidance/help will be appreciated
TX

I have a macro to insert the necessary rows for each current record.
The ID/Name data in the R column must then be inserted into the new rows???
IOW: If column R has 4 ID's/Names, that record must be repeated four times, one record for each name. Of course the other info I will duplicate into the columns as needed.

Workbook attached with data.

DATAFIX.xlsm

[HansV]

Like this:

Code: Select all

Sub InsertRows()
    Dim i As Long, r As Long, arr As Variant, cel As Range
    Application.ScreenUpdating = False
    For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        Set cel = Range("R" & r)
        arr = Split(cel.Value, ",")
        For i = UBound(arr) To 1 Step -1
            cel.EntireRow.Copy
            cel.Offset(1).EntireRow.Insert
            cel.Offset(1).Value = arr(i)
        Next i
        cel.Value = arr(0)
    Next r
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Note that the code does not select cells.

[Rudi]

Hans, i can only test it tomorrow morning when back at work, but the code looks great!!
I was expecting it to be three times as long as what you made it....
Awesome

Cheers

Will follow up tomorrow with the result.

[Rudi]

Hi Hans,

The code you supplied is a masterpiece in design, but it debugs with a SubScript out of range error at various points after various reruns? I thought it might be a memory overload on the variant variable, so I set it to nothing after each loop. It ran for a longer period, but still bombed on the same line (see images below).
Any ideas?

I can send the file to you in confidence if you'd like to test it on the actual data. It has over 10000 records...

2014-02-07_08h59_04.jpg

2014-02-07_08h56_15.jpg

[HansV]

Are there empty cells in column R?

[Rudi]

That did the trick.
There were a few and I filled it with the words: "No data"

Ran as smooth as a babies butt with talcum powder on it!

TX :)

[HansV]

An alternative would have been to test for empty cells:

Code: Select all

Sub InsertRows()
    Dim i As Long, r As Long, arr As Variant, cel As Range
    Application.ScreenUpdating = False
    For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        Set cel = Range("R" & r)
        If cel.Value <> "" Then
            arr = Split(cel.Value, ",")
            For i = UBound(arr) To 1 Step -1
                cel.EntireRow.Copy
                cel.Offset(1).EntireRow.Insert
                cel.Offset(1).Value = arr(i)
            Next i
            cel.Value = arr(0)
        End If
    Next r
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[Rudi]

Note that the code does not select cells.

Forgot to add: "Yes Mr. Vogelaar."

I have Option Explicit under the belt...
Now its a matter of wrapping me over the knuckles with "no cell selection"...
Sigh...I'll get there with your persistent tuition!

Thanks for the extra code.
It is a once off issue.