How to delete 3 rows?

[AdRock]

Domenic was very kind enough to help with a problem posted here but I would like to expand this code slightly.

What I would like to do with this code is after the 30 rows have been inserted and a page break added, delete the row which has the search term "Test" and the next 2 rows.

This gets rid of the rows that i don't need.

Can anyone please help?

Option Explicit

Sub test()

    Dim FoundCell As Range
    Dim FirstAddress As String
    Dim PrevAddress As String
    Dim CurrAddress As String
    Dim SearchTerm As String

    SearchTerm = "Test"

    With Columns("A")
        Set FoundCell = .Find(SearchTerm, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not FoundCell Is Nothing Then
            FoundCell.Name = "FirstAddress"
            Do
                PrevAddress = FoundCell.Address
                FoundCell.Resize(30).EntireRow.Insert
                ActiveSheet.HPageBreaks.Add before:=Range(PrevAddress)
                Set FoundCell = .FindNext(FoundCell)
            Loop While FoundCell.Address <> Range("FirstAddress").Address
        Else
            MsgBox "No search term found...", vbExclamation
        End If
    End With
        
End Sub

 

[JackDanIce]

Test on a dummy file as not sure this will quite work, looking at how your macro is looping for each value of "Test" but try (my additions in red):

Option Explicit

Sub test()

    Dim FoundCell As Range
    Dim FirstAddress As String
    Dim PrevAddress As String
    Dim CurrAddress As String
    Dim SearchTerm As String

    SearchTerm = "Test"

    With Columns("A")
        Set FoundCell = .Find(SearchTerm, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not FoundCell Is Nothing Then
            FoundCell.Name = "FirstAddress"
            Do
                PrevAddress = FoundCell.Address
                FoundCell.Resize(30).EntireRow.Insert
                ActiveSheet.HPageBreaks.Add before:=Range(PrevAddress)
Rows(FoundCell.row & ":" & Found.Cell.row+2).delete
                Set FoundCell = .FindNext(FoundCell)
            Loop While FoundCell.Address <> Range("FirstAddress").Address
        Else
            MsgBox "No search term found...", vbExclamation
        End If
    End With
        
End Sub

 

[AdRock]

Thanks for your reply.

I tried what you suggested and I get this error message

"Unable to get FindNext property of the Range class"

and it points to

Set FoundCell = .FindNext(FoundCell)

Any ideas what is going wrong here?

 

[JackDanIce]

Try changing my line in red to:

Rows(.FoundCell.row & ":" & .Found.Cell.row+2).delete

 

[AdRock]

Different error this time.

"Object doesn't support this property or method"

on line

Rows(.FoundCell.Row & ":" & .Found.Cell.Row + 2).Delete

 

[JackDanIce]

Ok, taken something I seen in your existing code, try:

Option Explicit

Sub test()

    Dim FoundCell As Range
    Dim FirstAddress As String
    Dim PrevAddress As String
    Dim CurrAddress As String
    Dim SearchTerm As String

    SearchTerm = "Test"

    With Columns("A")
        Set FoundCell = .Find(SearchTerm, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not FoundCell Is Nothing Then
            FoundCell.Name = "FirstAddress"
            Do
                PrevAddress = FoundCell.Address
                FoundCell.Resize(30).EntireRow.Insert
                ActiveSheet.HPageBreaks.Add before:=Range(PrevAddress)
FoundCell.Rezise(3).EntireRow.Delete
                Set FoundCell = .FindNext(FoundCell)
            Loop While FoundCell.Address <> Range("FirstAddress").Address
        Else
            MsgBox "No search term found...", vbExclamation
        End If
    End With
        
End Sub

The line in red is virtually identical to the line two above it so it should work now (famous last words)!

 

[AdRock]

Same error, same line

 

[JackDanIce]

I'd spelt resize wrong (rezise)

Option Explicit

Sub test()

    Dim FoundCell As Range
    Dim FirstAddress As String
    Dim PrevAddress As String
    Dim CurrAddress As String
    Dim SearchTerm As String

    SearchTerm = "Test"

    With Columns("A")
        Set FoundCell = .Find(SearchTerm, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not FoundCell Is Nothing Then
            FoundCell.Name = "FirstAddress"
            Do
                PrevAddress = FoundCell.Address
                FoundCell.Resize(30).EntireRow.Insert
                ActiveSheet.HPageBreaks.Add before:=Range(PrevAddress)
FoundCell.Resize(3).EntireRow.Delete
                Set FoundCell = .FindNext(FoundCell)
            Loop While FoundCell.Address <> Range("FirstAddress").Address
        Else
            MsgBox "No search term found...", vbExclamation
        End If
    End With
        
End Sub

 

[AdRock]

It deletes those 3 rows as it should but it's coming back with this error message again

<TABLE border=0 cellSpacing=0 cellPadding=6 width="100%"><TBODY><TR><TD style="BORDER-BOTTOM: 1px inset; BORDER-LEFT: 1px inset; BORDER-TOP: 1px inset; BORDER-RIGHT: 1px inset" class=alt2>"Unable to get FindNext property of the Range class" </TD></TR></TBODY></TABLE>
<TABLE border=0 cellSpacing=0 cellPadding=6 width="100%"><TBODY><TR><TD style="BORDER-BOTTOM: 1px inset; BORDER-LEFT: 1px inset; BORDER-TOP: 1px inset; BORDER-RIGHT: 1px inset" class=alt2>"Unable to get FindNext property of the Range class" </TD></TR></TBODY></TABLE>
<TABLE border=0 cellSpacing=0 cellPadding=6 width="100%"><TBODY><TR><TD style="BORDER-BOTTOM: 1px inset; BORDER-LEFT: 1px inset; BORDER-TOP: 1px inset; BORDER-RIGHT: 1px inset" class=alt2>"Unable to get FindNext property of the Range class" </TD></TR></TBODY></TABLE>

"Unable to get FindNext property of the Range class"