asked on

VBA find phrase and move rows to bottom of sheet

Referring to the attached, I need a code to find the phrase including PRP, then find the table right below, then choose all the rows and move to the bottom of the data - second blank row.

This must be VBA.

For instance, once PRP is found, rows 38 through 190 would be cut and pasted to row 441.
Extremely important.

Can anyone help?
Sample-PRP.xlsx

ASKER CERTIFIED SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

aikimark

Option Explicit

Sub Q_28698263()
    Dim rngSrc As Range
    Dim rngTgt As Range
    Dim wks As Worksheet
    Set wks = Worksheets("Sheet1")
    Set rngSrc = wks.Cells.Find("PRP")
    Debug.Print rngSrc.Address
    Set rngSrc = rngSrc.End(xlDown)
    Set rngSrc = wks.Range(rngSrc, rngSrc.End(xlDown))
    Set rngTgt = wks.Cells.SpecialCells(xlCellTypeLastCell).End(xlToLeft)
    rngSrc.EntireRow.Copy rngTgt
    rngSrc.EntireRow.Delete
End Sub

Open in new window

Euro5

ASKER

Perfect!

Martin Liss

Note that my solution only works for the first "PRP" it finds. In other words if there were two, the second wouldn't be moved.

Martin Liss

If there's a possibility of more than one "PRP" then use this version instead.

Sub MovePRP()
Dim lngRow As Long
Dim lngEnd As Long
Dim lngLastRow As Long

With ActiveSheet
    lngLastRow = .Range("A1048576").End(xlUp).Row
    For lngRow = lngLastRow To 1 Step -1
        If InStr(.Cells(lngRow, 1), "PRP") > 0 Then
            For lngEnd = lngRow + 2 To lngLastRow + 1
                If .Cells(lngEnd, 1) = "" Then
                    ' Normally cut and paste the range to the end of the sheet,
                    ' but if it's already at the end don't do anything
                    If lngEnd <> lngLastRow + 1 Then
                        .Rows(lngRow & ":" & lngEnd - 1).Cut
                        .Cells(lngLastRow + 1, 1).EntireRow.Insert
                    End If
                    Exit For
                End If
            Next
        End If
    Next
End With

Open in new window