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:

New Record
4756
John Doe
123 Street Ave.
Chicago, Illinois
451002
481002
New Record
4869
Jane Doe
0
0
New Record
5012
Jim Thompson
456 Street Ave.
New York, New York
451005
481005

<tbody>
</tbody>

Would Like:

New Record	4756	John Doe	123 Street Ave.	Chicago, Illinois	451002	481002
New Record	4869	Jane Doe	0	0
New Record	5012	Jim Thompson	456 Street Ave.	New York, New York	451005	481005

<tbody>
</tbody>

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"