VBA Code Update Help - moving a row to a new sheet based on cell data

[cmschmitz24]

I tried reusing an existing code that works for a different spreadsheet to update it and use it with a new spreadsheet and data set but it's bugging out. Someone please help It bugs out on "Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)". The third to last row of code.

Sub TEST()
'Moves REH Annuitants to a New Sheet
 Dim Rng As Range, r As Long, lastrow2 As Long, Lastrow As Long
    Application.ScreenUpdating = False

    Lastrow = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("REH Annuitant").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = Lastrow To 2 Step -1
            If Range("G" & r).Value = "S" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Union(Rng, Range("A" & r))
                End If
            End If
        Next r
        Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)
        Rng.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

*Data in columns D/E has been removed.

 

[Fluff]

From that image it looks as though there is nothing to delete to use

      Next r
      If Not Rng Is Nothing Then
         Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)
         Rng.EntireRow.Delete
      End If

 

[cmschmitz24]

Ah I meant to use column F instead of G. Your updates worked with the column tweak, thank you!

 

[cmschmitz24]

Ok new issue

I use this code twice, in a row, and the 2nd time through it bugs at:

Else
Set Rng = Union(Rng, Range("A" & r))
End If
End If
Next r
If Not Rng Is Nothing Then
Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)
Rng.EntireRow.Delete


Here's what I'm using. The first time through it works perfect.

'MOVES REHIRED ANNUITANTS TO NEW TAB
    Dim Rng As Range, r As Long, lastrow2 As Long
    Application.ScreenUpdating = False

    Lastrow = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("REH Annuitant").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = Lastrow To 2 Step -1
            If Range("L" & r).Value = "REH Annuitant" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Union(Rng, Range("A" & r))
                End If
            End If
        Next r
      If Not Rng Is Nothing Then
         Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)
         Rng.EntireRow.Delete
      End If
    Application.ScreenUpdating = True
    
      
    
'MOVES GRAD WRS MOVEMENTS TO NEW TAB
    Lastrow = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("Grad WRS Movement").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = Lastrow To 2 Step -1
            If Range("L" & r).Value = "Grad WRS Movement" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Union(Rng, Range("A" & r))
                End If
            End If
        Next r
      If Not Rng Is Nothing Then
         Rng.EntireRow.Copy Worksheets("Grad WRS Movement").Range("A" & lastrow2 + 1)
         Rng.EntireRow.Delete
      End If
    Application.ScreenUpdating = True

 

[Fluff]

Add this just before the 2nd part of your code

Set Rng = Nothing

 

[cmschmitz24]

Whoops, my bad. I stated the wrong code where it bugs. The code above is correct, but here's where it first bugs.

 

[Fluff]

Did you try what I suggested?

 

[cmschmitz24]

Yes, it worked... but it only moved 1 row over to the new tab. It didn't find all the data points in the first sheet.

 

[Fluff]

So the error message has gone?
Do you have more than one row with "Grad WRS Movement"in col L, remember that VBA is case sensitive.
What sheet is active when you get to the 2nd part of the code?

 

[cmschmitz24]

Yes, the error message went away. And all the cells with "Grad WRS Movement" are the same. There's a search/nested if then statement that finds cases and adds the same text to each cell applicable.