VBA Translate Column Data into Rows

[tryingmybest418]

I have a column of information and would like to find a way to translate it into rows using VBA. Every 3-7 rows in my existing column has a cell "New Record". I'd like the information below that cell to be laid out in a new row.

Currently:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]New Record[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4756[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Doe[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]123 Street Ave.[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Chicago, Illinois[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]451002[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]481002[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]New Record[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4869[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jane Doe[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]New Record[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5012[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jim Thompson[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]456 Street Ave.[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]New York, New York[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]451005[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]481005[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Would Like:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]New Record[/TD]
[TD]4756[/TD]
[TD]John Doe[/TD]
[TD]123 Street Ave.[/TD]
[TD]Chicago, Illinois[/TD]
[TD]451002[/TD]
[TD]481002[/TD]
[/TR]
[TR]
[TD]New Record[/TD]
[TD]4869[/TD]
[TD]Jane Doe[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]New Record[/TD]
[TD]5012[/TD]
[TD]Jim Thompson[/TD]
[TD]456 Street Ave.[/TD]
[TD]New York, New York[/TD]
[TD]451005[/TD]
[TD]481005[/TD]
[/TR]
</tbody>[/TABLE]

Thank you!

 

[VBA Geek]

Sub tryingmybest418()
Dim A As Range
With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    .Replace "New Record", "", xlWhole, xlByRows
    For Each A In .SpecialCells(xlCellTypeConstants).Areas
        With Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(, A.Rows.Count)
            .Value = Application.Transpose(A.Value)
            A.ClearContents
            .Offset(, -1).Resize(1, 1).Value = "New Record"
        End With
    Next A
End With
End Sub

 

[tryingmybest418]

That's it! Thank you so much.

Can I ask if there's a clean way to do this and remove the "New Record" column?

I recorded this and would add it to the end of the code you provided, but am curious if you think there's a better way?

Sub DeleteNewRecord()


    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub

 

[VBA Geek]

That's it! Thank you so much.

Can I ask if there's a clean way to do this and remove the "New Record" column?

I recorded this and would add it to the end of the code you provided, but am curious if you think there's a better way?

Sub DeleteNewRecord()


    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub

maybe try to remove the below line and see if it works for you?

remove:
.Offset(, -1).Resize(1, 1).Value = "New Record"