VBA to find range of cells with value and move them to different range

[edgarsrom]

Hello all,

Could anyone help out with VBA code please? I have set of data in columns A, B and C(around 2000 rows in total). I would like to find all values which contain string "TOP01" or "TOP02" within column A, once string is found(there could be more than 50 records matching those keywords) then move cell values from column A, B and C to columns E, F and G starting from row 1 onward.

For example:

Range A1142 contains keyword "TOP01", range B1142 contains value "11231", range C1142 contains value "30.24" - I would like to move them in E1, F1 and G1 respectively.
Then next matching keyword cell found, say in range A1524 with to be moved into cell E2 and values from same row(in B1524, C1524) into E2, F2 and G2, and so on...

After that to shift cells up to fill empty cells.

Is it achievable by using "for" loop only? Or is there an easier way of doing that to avoid slowing down the macro?

Any help much appreciated.

Thanks.

 

[Scott T]

try

Sub movedata()
Dim lr As Long
Dim lre As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
lre = Cells(Rows.Count, 5).End(xlUp).Row

For x = 1 To lr
    If Cells(x, 1) = "top01" Or Cells(x, 1) = "top02" Then
        If Range("E1") <> "" Then
            Range(Cells(x, 1), Cells(x, 3)).Cut Range("E" & lre + 1)
        End If
        If Range("E1") = "" Then
            Range(Cells(x, 1), Cells(x, 3)).Cut Range("E" & lre)
        End If
        
        lre = Cells(Rows.Count, 5).End(xlUp).Row
    End If
Next x
For y = lr To 1 Step -1
    If Cells(y, 1) = "" Then
        Range(Cells(y, 1), Cells(y, 3)).Delete Shift:=xlUp
    End If
Next y
End Sub

 

[edgarsrom]

Absolutely spot on! Thank you very much for your help!!! Works perfect and very efficient