Macro that deletes rows below a certain value

Hello,

I am looking for help in creating a macro that will delete the 42 rows below a cell and the cell itself that contain the following value; (any number) of (any number)



For example a cell containing ; 3 of 18, would be deleted along with the 42 cells (rows) below that. All of the data is in column A.

Any help would be greatly appreciated.

Thanks!

D

Not tested but maybe:

Sub test()

Dim lngLoopRow As Long

For lngLoopRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1

    If Range("A" & lngLoopRow) = "3 of 18" Then
    
        Range("A" * lngLoopRow).Resize(43, 1).EntireRow.Delete
        
    End If
    
Next lngLoopRow

End Sub

Dom

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook.

If needed supply a before and after sheet in the workbook so the person helping you can see what you are trying to achieve.

Doing this will ensure you get the result you need!

Will there be any other entries in column A that follow the format '? of ?'

Dom

hi Biased Historian

Originally Posted by Biased Historian

Range("A" * lngLoopRow).Resize(43, 1).EntireRow.Delete

Try changing the "*" for an "&".

I'll have a play & post something else in a while...


hth
Rob

hi Biased Historian,

Here's a slightly different approach which worked on my test data - if I understand your needs correctly...
I haven't used this approach before, would you mind letting me know how fast it runs compared to Dom's version on your real data?

option explicit
Sub test2()
Const pbStr As String = " of "    'page break string
Const NumOfRwsToDel As Long = 43
Const FirstRow As Long = 2
Dim LastRow As Long
Dim i As Long    'reused loop index
Dim rngArr As Variant
Dim ws As Worksheet
Dim pbRowColl As Collection    'page break row collection
Dim curStr As String    'current string
Dim LocOfpbStr As Long    'location of page break string

    Set ws = ActiveSheet
    Set pbRowColl = New Collection

    'create an "in memory" variant array of the info in column A
    With ws
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        rngArr = .Range(.Cells(FirstRow, "a"), .Cells(LastRow, "a"))
    End With


    For i = LBound(rngArr) To UBound(rngArr)
        curStr = rngArr(i, 1)
        LocOfpbStr = InStr(1, curStr, pbStr)
        If LocOfpbStr Then
            If IsNumeric(Left(curStr, LocOfpbStr - 1)) And IsNumeric(Right(curStr, Len(curStr) - (LocOfpbStr + Len(pbStr) - 1))) Then
                With pbRowColl
                    .Add Item:=FirstRow - LBound(rngArr) + i
                End With
            End If
        End If
    Next i

    'loop through the page break row collection backwards & select ('delete) the desired rows
    For i = pbRowColl.Count To 1 Step -1
        With ws
            .Cells(pbRowColl.Item(i), "a").Resize(NumOfRwsToDel, .Columns.Count).Select    'Delete
        End With
    Next i

    'For lngLoopRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    '    If Range("A" & lngLoopRow) = "3 of 18" Then
    '        Range("A" * lngLoopRow).Resize(43, 1).EntireRow.Delete
    '    End If
    'Next lngLoopRow

    Set ws = Nothing
    Set pbRowColl = Nothing
End Sub

hth
Rob

hi,

Deleting rows changes the Row Number of any remaining rows that are below where the deleted rows previously existed (ie they all get renumbered), therefore row deletions are best to do from the bottom of your data up to the top. This is why both Dom & my code includes the statement "step -1" in the first line of the Loop (so it goes "backwards" or "upwards").

In my code you can change:

.Cells(pbRowColl.Item(i), "a").Resize(NumOfRwsToDel, .Columns.Count).Select    'Delete

to

.Cells(pbRowColl.Item(i), "a").Resize(NumOfRwsToDel, .Columns.Count).Delete

and everything should get deleted.

hth
Rob

Rob,

Thank you very much, swapping those two lines did the trick! Even better my theory that eliminating the data signifying page breaks on a report would address an issue from a more complex formatting code appears to be spot on.

Dom thank you for your efforts! I tipped the scale towards both of you.

I ran your code first, then a larger one by waterserv, and now items that were being dropped on page breaks are being accounted for.

Thanks again!!!


Dave

hi Dave,

I'm pleased we could help - Thanks for adding to our rep

I haven't tested it, but here is a slight change to Dom's code which may work...

option explicit
Sub modified_test()
Dim lngLoopRow As Long
Dim NumOfPBs As Long    'Total number of page breaks.
Dim curPBNum As Long    'current page break number

    'ask the user...
    NumOfPBs = Application.InputBox("Please enter the total number of pages that are in this report:", "How many pages...?", Type:=1)

    If NumOfPBs > 2 Then
        'set the intial value of curPBNum to equal the last value on the report
        curPBNum = NumOfPBs
        'loop from bottom to top
        For lngLoopRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            If Range("A" & lngLoopRow) = curPBNum & " of " & NumOfPBs Then
                Range("A" * lngLoopRow).Resize(43, 1).EntireRow.Delete
                'decrease the page number for the next iteration of the loop
                curPBNum = curPBNum - 1
            End If
        Next lngLoopRow
    End If
End Sub

hth
Rob