VBA remove or insert rows by phrase

The code Sub RMGRNet2() in Net Rate 2 is identical to others, including PRP2(), but I get an error and the code stops.

The code should look for RMGR in the sheet, then either remove rows or insert rows, to result in one blank row between
'RMGR' & the table below it.

I have double checked if the name is wrong, but I can't find why this is not working.
I am attaching example - Can anyone help?
Rerate-v5.3-sample.xlsm
Euro5Asked:
Who is Participating?
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.

Martin LissOlder than dirtCommented:
I don't get an error but the the following returns 1 which you don't account for.

rngFindH2.Row - rngFindH1.MergeArea.Cells(1, 1).Offset(1).Row

What do you want to do in this case?
0
Saurabh Singh TeotiaCommented:
You can use the following code and it will do what you are looking for..

Sub RMGRNet2()
    Application.ScreenUpdating = False
    Net_Rates_2.Activate

    Dim rngFindH1 As range
    Dim rngFindH2 As range
    Set rngFindH1 = ActiveSheet.range("A:A").Find("Package Type(s): RMGR")
    If Not (rngFindH1 Is Nothing) Then Set rngFindH2 = ActiveSheet.range("A:A").Find("Weight (in Lbs )", after:=rngFindH1)


    Dim lr As Long

    If Not (rngFindH1 Is Nothing) And Not (rngFindH2 Is Nothing) Then
        lr = rngFindH2.Row - rngFindH1.Row

        If lr > 2 Then
            Rows(rngFindH1.Row + 1 & ":" & rngFindH1.Row + lr - 2).Delete
        ElseIf lr = 1 Then
            rngFindH2.EntireRow.Insert

        End If
    End If


End Sub

Open in new window


Saurabh...
0
Euro5Author Commented:
@Martin - it would do nothing with =1.
That would mean that there was one blank space between the header and the table.

@Saurabh - I tried your code, and when I choose Net Rate Sheet 2 and run the macro it works perfectly.
But when I run with all the other code - pushing the button Re-Rate on Enter Data sheet, the run stops at this code. Can you help me identify why??
Module 6 Call_Net_Rates_2.RMGRNet2
Rerate-v5.3-sample-RMGR.xlsm
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

Martin LissOlder than dirtCommented:
You are getting the error because the range you want to move to the bottom is already at the bottom. This will fix that. (I added rows 17 and 20)

Sub MoveRMGR2()
Dim lngRow As Long

Dim rngRMGR As range
Net_Rates_2.Activate
With ActiveSheet
    Set rngRMGR = .Cells.Find(What:="RMGR", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    If Not rngRMGR Is Nothing Then
        For lngRow = rngRMGR.Row + 2 To .UsedRange.Rows.Count
            If .Cells(lngRow, 1) = "" Then
                lngRow = lngRow - 1
                Exit For
            End If
        Next
    End If
    
    If .UsedRange.Rows.Count + 1 <> lngRow Then
        .Rows(rngRMGR.Row & ":" & lngRow).Cut
        .Cells(.UsedRange.Rows.Count + 1, 1).EntireRow.Insert
    End If
End With

End Sub

Open in new window

0
Euro5Author Commented:
@Martin - what if there is no PRP or RMGR? can we have it exit?
0
Martin LissOlder than dirtCommented:
Do you mean exit the MoveRMGR2 and MovePRP subs? If so It will. If you mean you want to exit the RunSeries sub then I have other questions.
0
Euro5Author Commented:
I'm just seeing that when there is a PRP or RMGR in the sheet, it does work. But in the other sheet there is no PRP or RMGR present in the sheet, I get the error
Object variable or with block variable not set.

Each set of Net Rate sheets may contain any combination of services including PRP or RMGR or not.
0
Saurabh Singh TeotiaCommented:
Euro,

Use this code and it will do what you are looking for..It doesn't matter from which sheet/module you are running this from now...

Sub RMGRNet2()
Dim ws As Worksheet

Set ws = Net_Rates_2
    Application.ScreenUpdating = False
   
   

    Dim rngFindH1 As range
    Dim rngFindH2 As range
    Set rngFindH1 = ws.range("A:A").Find("Package Type(s): RMGR")
    If Not (rngFindH1 Is Nothing) Then Set rngFindH2 = ws.range("A:A").Find("Weight (in Lbs )", after:=rngFindH1)


    Dim lr As Long

    If Not (rngFindH1 Is Nothing) And Not (rngFindH2 Is Nothing) Then
        lr = rngFindH2.Row - rngFindH1.Row

        If lr > 2 Then
            ws.Rows(rngFindH1.Row + 1 & ":" & rngFindH1.Row + lr - 2).Delete
        ElseIf lr = 1 Then
            rngFindH2.EntireRow.Insert

        End If
    End If


End Sub

Open in new window


Saurabh...
0
Martin LissOlder than dirtCommented:
Add lines 15 and 16.
Sub MoveRMGR2()
Dim lngRow As Long

Dim rngRMGR As range
Net_Rates_2.Activate
With ActiveSheet
    Set rngRMGR = .Cells.Find(What:="RMGR", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    If Not rngRMGR Is Nothing Then
        For lngRow = rngRMGR.Row + 2 To .UsedRange.Rows.Count
            If .Cells(lngRow, 1) = "" Then
                lngRow = lngRow - 1
                Exit For
            End If
        Next
    Else
        Exit Sub
    End If
        
    If .UsedRange.Rows.Count + 1 <> lngRow Then
        .Rows(rngRMGR.Row & ":" & lngRow).Cut
        .Cells(.UsedRange.Rows.Count + 1, 1).EntireRow.Insert
    End If
End With

End Sub

Open in new window

0

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:
Thank you!!
0
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.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.