VBA: Moving rows to a new sheet based on multiple criteria and delete from original sheet

[simss6]

Hi there!

I have found similar threads on these forums but none that do exactly what I am trying to do.
I have a main sheet "Operators" that has multiple columns that I am try to pull data from into different sheets.

If column I="Recertify", then move entire row to "Recertify" sheet, pasting under the header/data that already is in the sheet and deleting row from the "Operator" sheet
If column G="-"or" "or a date before 1/1/22 and column H="completed" or "complete", then move entire row to "No QC" sheet, pasting under the header/data that already is in the sheet and deleting row from the "Operator" sheet
If column G= a date after 12/31/22 and Column H="Not enrolled" or "Not Started" or "In Progress" or "Incomplete, the move the entire row to "No Edu" pasting under the header/data that already is in the sheet and deleting row from the "Operator" sheet
If column G="-"or" "or a date before 1/1/22 and column H="Not enrolled" or "Not Started" or "In Progress" or "Incomplete, the move the entire row to "Neither" pasting under the header/data that already is in the sheet and deleting row from the "Operator" sheet

Hope that made sense. I really appreciate it!

 

[Max1616]

I think this will accomplish what you're looking for based off your description. Let me know if it needs adjustments:

Option Compare Text

Sub RowMove()
Dim lrow1 As Long
Dim lrow2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long

Set ws1 = Sheets("Operators")
lrow1 = ws1.Cells(Rows.Count, 8).End(xlUp).Row

For i = lrow1 To 2 Step -1
    Set ws2 = Nothing

    If ws1.Cells(i, 9) = "Recertify" Then Set ws2 = Sheets("Recertify")
    If (ws1.Cells(i, 7) = "-" Or ws1.Cells(i, 7) < DateSerial(2022, 1, 1)) And (ws1.Cells(i, 8) = "completed" Or ws1.Cells(i, 8) = "complete") Then Set ws2 = Sheets("No QC")
    If (ws1.Cells(i, 7) = "-" Or ws1.Cells(i, 7) < DateSerial(2022, 1, 1)) And (ws1.Cells(i, 8) = "Not enrolled" Or ws1.Cells(i, 8) = "Not started" Or ws1.Cells(i, 8) = "In Progress" Or ws1.Cells(i, 8) = "Incomplete") Then Set ws2 = Sheets("Neither")
    If ws1.Cells(i, 7) >= DateSerial(2022, 1, 1) And (ws1.Cells(i, 8) = "Not enrolled" Or ws1.Cells(i, 8) = "Not started" Or ws1.Cells(i, 8) = "In Progress" Or ws1.Cells(i, 8) = "Incomplete") Then Set ws2 = Sheets("No Edu")
    
    If ws2 Is Nothing Then GoTo Nexti

    lrow2 = ws2.Cells(Rows.Count, 8).End(xlUp).Row + 1

ws1.Cells(i, 1).EntireRow.Copy ws2.Cells(lrow2, 1).EntireRow
ws1.Cells(i, 1).EntireRow.Delete

Nexti:
Next i

End Sub

 

[simss6]

The recertify and the No QC work perfectly, the "Neither and the "No edu" all went into the "No edu" sheet.

This is awesome though, thank you, thank you!

 

[Max1616]

Interesting, there must be an issue with the dates all reading after 1/1/2022. Could you attach a screenshot of a row that should be going to the "Neither" sheet?

 

[simss6]

Those last four that have the "-" listed as the last QC test, column "G"

 

[Max1616]

I'm unsure why, but for some reason this is firing as true when the date = "-"

ws1.Cells(i, 7) >= DateSerial(2022, 1, 1)

I slightly edited the code to account for this:

Option Compare Text

Sub RowMove()
Dim lrow1 As Long
Dim lrow2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long

Set ws1 = Sheets("Operators")
lrow1 = ws1.Cells(Rows.Count, 8).End(xlUp).Row

For i = lrow1 To 2 Step -1
    Set ws2 = Nothing

    If ws1.Cells(i, 9) = "Recertify" Then Set ws2 = Sheets("Recertify")
    If (ws1.Cells(i, 7) = "-" Or ws1.Cells(i, 7) < DateSerial(2022, 1, 1)) And (ws1.Cells(i, 8) = "completed" Or ws1.Cells(i, 8) = "complete") Then Set ws2 = Sheets("No QC")
    If (ws1.Cells(i, 7) = "-" Or ws1.Cells(i, 7) < DateSerial(2022, 1, 1)) And (ws1.Cells(i, 8) = "Not enrolled" Or ws1.Cells(i, 8) = "Not started" Or ws1.Cells(i, 8) = "In Progress" Or ws1.Cells(i, 8) = "Incomplete") Then Set ws2 = Sheets("Neither")
    If ws1.Cells(i, 7) <> "-" And ws1.Cells(i, 7) >= DateSerial(2022, 1, 1) And (ws1.Cells(i, 8) = "Not enrolled" Or ws1.Cells(i, 8) = "Not started" Or ws1.Cells(i, 8) = "In Progress" Or ws1.Cells(i, 8) = "Incomplete") Then Set ws2 = Sheets("No Edu")
    
    If ws2 Is Nothing Then GoTo Nexti

    lrow2 = ws2.Cells(Rows.Count, 8).End(xlUp).Row + 1

ws1.Cells(i, 1).EntireRow.Copy ws2.Cells(lrow2, 1).EntireRow
ws1.Cells(i, 1).EntireRow.Delete

Nexti:
Next i

End Sub

 

[simss6]

YOU ARE AMAZING! Thank you so much for all of your help. Everything is working properly.

 

[Max1616]

Glad I could help!