VB to search for a key word in Column A, then copy it to column B for multiple rows.

[newbieMark]

vbaquestionexample.xlsxvbaquestionexample.xlsxI have a raw data export with 9,000 rows.

I would like to have a VB/Macro to look thru it and find a key word at beginning of a row, then copy that full cell value to column B and do so for as many rows below it as necessary to map, so to speak, each subsequent row to the appropriate heading.

It's easier to show a picture: see below.
note that each person is the "heading" so to speak and their attributes are underneath. Not that they all have different attributes.

I imagine that the VB will look for "name" and then paste the full cell value to column B, and keep doing so until it hits a blank (sometimes there's 1 blank, sometimes there's 2 blanks) OR until it finds a new "name" and then do the same.

HERES MY RAW DATA DUMP SNIPPET x9,000 rows I WANT A VB TO DO THIS name Tom Johnson name Tom Johnson height 5'7" name Tom Johnson sex Male name Tom Johnson kids 3 name Tom Johnson irrelevant data irrelevant data irrelevant data name Jane Doe name Jane Doe height 5'7" name Jane Doe sex Female name Jane Doe weight 140 name Jane Doe kids 3 name Jane Doe irrelevant data name Jack Doe name Jack Doe height 5'7" name Jack Doe job IT Manager name Jack Doe weight 190 name Jack Doe kids 3 name Jack Doe sex Male name Jack Doe 

[westconn1]

i tested this on the sample data above

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Set fnd = Range("a1:a" & lastrow).Find("name", Range("a" & lastrow))
If Not fnd Is Nothing Then
    frst = fnd.Row
    Do
        nd = fnd.End(xlDown).Row
        fnd.Resize(nd - fnd.Row + 1).Offset(, 1).Value = fnd.Value
        Set fnd = Range("a1:a" & lastrow).Find("name", fnd)
    Loop While Not fnd.Row = frst
End If

[apo]

Hi..

Here's another way..

With 9000 rows, it only takes less than a second.. so Application.ScreenUpdating = False/True is not really needed though..

Private Sub CommandButton1_Click()
    Dim myArea
    Application.ScreenUpdating = False
    For Each myArea In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(2).Areas
        If myArea.Cells(1) Like "name *" Then
            myArea.Offset(, 1).Resize(myArea.Rows.Count).Value = myArea.Cells(1)
        End If
    Next myArea
    Application.ScreenUpdating = True
End Sub

[newbieMark]

Awesome! Thanks guys! This'll go easily into my Access DB and I can match records now. I appreciate it!!