VBA phrase remove rows not working

This code should leave one row between the header -  
"Domestic Priority Overnight" and the phrase "Weight (in Lbs )"  in a row below.
(I repeat this for multiple services, so I included the "Domestic Standard Overnight")

They are never on the same row or the same number of rows apart.
This seemed to be working for some services, but then others it failed, but I'm not sure why.

I am attaching the sheet that it is not working with, hoping someone can identify & help.


Sub PONET1()
Application.ScreenUpdating = False
    Net_Rates_1.Activate
    
    Dim rngFindH1 As Range
    Dim rngFindH2 As Range
    Set rngFindH1 = ActiveSheet.Range("A:C").Find("Domestic Priority Overnight")
    If (rngFindH1 Is Nothing) Then
    Else
        Set rngFindH2 = ActiveSheet.Range("A:A").Find("Weight (in Lbs )", after:=rngFindH1.Cells(1, 1))
    End If
    If (rngFindH1 Is Nothing) Or (rngFindH2 Is Nothing) Then
    Else
        Select Case rngFindH2.Row - rngFindH1.MergeArea.Cells(1, 1).Offset(1).Row
            Case Is >= 2
                ActiveSheet.Range(rngFindH1.MergeArea.Cells(1, 1).Offset(1), _
                        rngFindH2.Offset(-2)).EntireRow.Delete
            Case 0
                rngFindH2.EntireRow.Insert
            Case Else
        End Select
    End If
End Sub

Sub SONET1()
Application.ScreenUpdating = False
    Net_Rates_1.Activate
    
    Dim rngFindH1 As Range
    Dim rngFindH2 As Range
    Set rngFindH1 = ActiveSheet.Range("A:C").Find("Domestic Standard Overnight")
    If (rngFindH1 Is Nothing) Then
    Else
        Set rngFindH2 = ActiveSheet.Range("A:A").Find("Weight (in Lbs )", after:=rngFindH1.Cells(1, 1))
    End If
    If (rngFindH1 Is Nothing) Or (rngFindH2 Is Nothing) Then
    Else
        Select Case rngFindH2.Row - rngFindH1.MergeArea.Cells(1, 1).Offset(1).Row
            Case Is >= 2
                ActiveSheet.Range(rngFindH1.MergeArea.Cells(1, 1).Offset(1), _
                        rngFindH2.Offset(-2)).EntireRow.Delete
            Case 0
                rngFindH2.EntireRow.Insert
            Case Else
        End Select

Open in new window

Insert-Row.xlsx
Euro5Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
I think you have attached the wrong workbook. It contains no code and is only a blank form
Euro5Author Commented:
@Roy, I tried again.
Roy CoxGroup Finance ManagerCommented:
Where's the new workbook?
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

Euro5Author Commented:
I edited the old entry. Let me attach again here.
Insert-Row.xlsx
Martin LissOlder than dirtCommented:
You can't save a workbook that contains code as an xlsx since that will remove all code. Save the workbook that does contain code as an xlsm.
Roy CoxGroup Finance ManagerCommented:
The code is not complete above so I cannot even paste it into the example. Provide the actual workbook that is problematic, remove ant sensitive data first
Euro5Author Commented:
Sorry - I misunderstood. Hope this helps.
remove-rows.xlsm
Martin LissOlder than dirtCommented:
Euro, in post ID: 40823768 in this thread I provided the following code.

Sub DeleteThem()
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngEnd As Long
Dim bOK As Boolean

Application.ScreenUpdating = False

With ActiveSheet
    lngLastRow = .Range("A1048576").End(xlUp).Row
    
    For lngRow = lngLastRow To 1 Step -1
        If .Cells(lngRow, 1) = "Domestic First Overnight Non-Freight" Or _
           .Cells(lngRow, 1) = "Continental US Home Delivery" Or _
           .Cells(lngRow, 1) = "Ground - Ground Multiweight Rates" Then
            bOK = False
            For lngEnd = lngRow + 1 To lngLastRow
                ' Look for special ending phrases
                If .Cells(lngEnd, 1) = "Please refer to list rates for this service." Or _
                   .Cells(lngEnd, 1) = "Net Rates are not available for these services" Then
                    Exit For
                End If
                ' Look for a rate table.
                If InStr(1, .Cells(lngEnd, 1), "Weight") > 0 Then
                    ' We found one so quit this search
                    bOK = True
                    Exit For
                End If
            Next
            If Not bOK Then
                Range(.Cells(lngRow, 1), .Cells(lngEnd, 1)).EntireRow.Delete
            End If
        End If
    Next
End With

Application.ScreenUpdating = True
End Sub

Open in new window


That code should work for  for "Domestic First Overnight Non-Freight", "Continental US Home Delivery" and "Ground - Ground Multiweight Rates" if they are followed by either "Please refer to list rates for this service." or "Net Rates are not available for these services". It deletes them and everything in between if there is no rate table between them. In the code it is assumed that the rate table will contain the word "Weight" someplace in column A.

If you want to also include "Domestic Standard Overnight" then change lines 13 to 15 to

              If .Cells(lngRow, 1) = "Domestic First Overnight Non-Freight" Or _
           .Cells(lngRow, 1) = "Continental US Home Delivery" Or _
           .Cells(lngRow, 1) = "Domestic Standard Overnight" Or _
           .Cells(lngRow, 1) = "Ground - Ground Multiweight Rates" Then

Open in new window


If all tables don't contain the word "Weight" then change this line

 If InStr(1, .Cells(lngEnd, 1), "Weight") > 0 Then

to

If InStr(1, .Cells(lngEnd, 1), "Weight") > 0 Or  InStr(1, .Cells(lngEnd, 1), "some other word") > 0 Then

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Euro5Author Commented:
all tables include the word Weight...
Euro5Author Commented:
OH...it does BOTH!!? I see....let me try taking out the other code...
Martin LissOlder than dirtCommented:
If you still have a problem then please post the workbook as an xlsm file and tell me what header and it's row number that isn't working.
Euro5Author Commented:
Ok, that worked and I did need the alternates. Thanks!!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.