Expanding columns out into rows with unique criteria

[FirstWorldAnalyst]

Hi All!

First off, I apologize at my horrible attempt to title this thread - I'm sure there's a much better way to word it. I'm pretty stumped on this one. I'm working with a fairly large database (~5K rows) of reservation numbers & email addresses. Please forgive my poor attempt at describing my problem:

I have two columns to work with, "Reservation Numbers" & "Email Addresses". If there's one email address per reservation number, they'll line up in the same row. However, if there are two or more emails assigned to a reservation number, an extra row is inserted with a (blank) in the reservation number column. I'm trying to branch out "Emails" column into new rows but also aligned with the correct "Reservation Number" row.

I'm trying to turn this:

[TABLE="width: 333"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Reservation Numbers[/TD]
[TD]Email Addresses[/TD]
[/TR]
[TR]
[TD="align: right"]10010[/TD]
[TD]jo.bob@gmail.com[/TD]
[/TR]
[TR]
[TD="align: right"]10011[/TD]
[TD]amy.smith@gmail.com[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]george.robinson@gmail.com[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]tom.nelson@gmail.com[/TD]
[/TR]
[TR]
[TD="align: right"]10012[/TD]
[TD]jacob.riely@gmail.com[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]nathan.brown@gmail.com[/TD]
[/TR]
</tbody>[/TABLE]


Into this:

[TABLE="width: 681"]
<colgroup><col><col span="2"><col></colgroup><tbody>[TR]
[TD]Reservation Numbers[/TD]
[TD]Email Addresses[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]10010[/TD]
[TD]jo.bob@gmail.com[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]10011[/TD]
[TD]amy.smith@gmail.com[/TD]
[TD]george.robinson@gmail.com[/TD]
[TD]tom.nelson@gmail.com[/TD]
[/TR]
[TR]
[TD="align: right"]10012[/TD]
[TD]jacob.riely@gmail.com[/TD]
[TD]nathan.brown@gmail.com[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I hope this all makes sense. Thank you for taking the time to read through and I look forward to any/all replies!

Thank you, again!

 

[JLGWhiz]

See if this will do what you want.

Sub t()
Dim i As Long
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Cells(i, 1) = "" Then
            Cells(i, 2).Cut Cells(i, 1).End(xlUp).End(xlToRight).Offset(, 1)
            Rows(i).Delete
        End If
    Next
End Sub

 

[jim may]

I worked up this code...

Sub Foo()
Dim i As Long
j = 0
    For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row  ' to row 12
        If Cells(i, 1) = "" Then
        j = j + 1
            Cells(i, 2).Copy
            Cells(i - j, 2 + j).PasteSpecial _
            Paste:=xlPasteValues
        Else
        j = 0
        End If
    Next
Application.CutCopyMode = False
End Sub