Need Excel macro that will look at text in specific field and copy to a corresponding sheet based on the text found

[stressler]

I am looking for a macro that will read column D on my "Data Sheet" tab and depending on the text found copy and paste the entire row to the corresponding sheet in the workbook. As and example, if the phrase Not Covered is found in column D on Data Sheet, copy the entire row to the worksheet called "Not Covered". I'll need this to repeat for all rows on "Data Sheet" so I could end up with many rows of copied data on the "Not Covered" worksheet. I'll have the following phrases in column D on "Data Sheet" and corresponding worksheets, Not Covered, No Run, Not Completed, Blocked and Failed. I'll need "Data Sheet" reviewed for all of these phrases and the entire row copied and pasted into the corresponding worksheet with same name for all rows of data on "Data Sheet". Then I have two more specific requests for two additional tabs. Not Testable and Passed. Not Testable criteria is that in the text to be found in column D on data sheet is "N/A" and column E on "Data Sheet" is not empty. Then for Passed worksheet, the criteria is that column D on data sheet has the word Passed in it or has N/A in column D of data sheet and column E of data sheet is empty. So the last two phrases where I want to copy the full row from Data Sheet to the corresponding worksheet (Not Testable and Passed) have multiple criteria to be searched. Any help would be appreciated. I can create a macro on each individual sheet and run it so that it pulls from the Data Sheet and pastes into each individual worksheet, but that's a lot of clicking of the Run Macro button unnecessarily. I need a macro that will complete all searches in one run of the macro from the "Data Sheet" tab.

 

[davesexcel]

Could you write this in a way that we can read it?

 

[MARK858]

@stressler is the below a correct summation of post one so far?

• Search column D on sheet "Data Sheet" if cells have the text "Not Covered", "No Run", "Not Completed", "Blocked" or "Failed" copy and paste entire row to the sheets with the same names.
• Search column D on sheet "Data Sheet" if cell has "N/A" and column E on "Data Sheet" is not empty then copy entire row to sheet "Not Testable"
• Search column D on sheet "Data Sheet" if cell either has the text "Passed" or has "N/A" in column D and column E is empty then copy entire row to sheet "Passed"

 

[stressler]

@stressler is the below a correct summation of post one so far?

• Search column D on sheet "Data Sheet" if cells have the text "Not Covered", "No Run", "Not Completed", "Blocked" or "Failed" copy and paste entire row to the sheets with the same names.
• Search column D on sheet "Data Sheet" if cell has "N/A" and column E on "Data Sheet" is not empty then copy entire row to sheet "Not Testable"
• Search column D on sheet "Data Sheet" if cell either has the text "Passed" or has "N/A" in column D and column E is empty then copy entire row to sheet "Passed"

This is exactly correct! Thank you for making it so concise for me

 

[stressler]

I see this one hasn't gotten any response on solution yet. Is it too complicated? I will take any piece of it that can be done for now and I can work on the rest of it that cannot be done via the same macro individually.

 

[MARK858]

I see this one hasn't gotten any response on solution yet.

I don't have time to look at this tonight (please note all are volunteers and go on the board in their spare time which is partly why the board recommends leaving it 24 hours before bumping the thread).

I will see if I have time to look at it tomorrow if no-one else responds to your clarification.

 

[stressler]

Thank you Mark858, I just wanted to make sure my ask wasn't too complex, I'm willing to work on something more simple, if that's what's needed, just let me know. Thanks.

 

[My Aswer Is This]

See if this does part of what you want:

Sub Copy_Rows()
'Modified  12/12/2019  8:56:42 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "D").End(xlUp).Row

For i = 1 To Lastrow
    Select Case Cells(i, "D").Value
    
        Case "Not Covered"
            Lastrow = Sheets(Cells(i, "D").Value).Cells(Rows.Count, "D").End(xlUp).Row + 1
            Rows(i).Copy Sheets(Cells(i, "D").Value).Rows(Lastrow)
        
        Case "No Run"
            Lastrow = Sheets(Cells(i, "D").Value).Cells(Rows.Count, "D").End(xlUp).Row + 1
            Rows(i).Copy Sheets(Cells(i, "D").Value).Rows(Lastrow)
        
        Case "Not Completed"
            Lastrow = Sheets(Cells(i, "D").Value).Cells(Rows.Count, "D").End(xlUp).Row + 1
            Rows(i).Copy Sheets(Cells(i, "D").Value).Rows(Lastrow)

        Case "Blocked"
            Lastrow = Sheets(Cells(i, "D").Value).Cells(Rows.Count, "D").End(xlUp).Row + 1
            Rows(i).Copy Sheets(Cells(i, "D").Value).Rows(Lastrow)
    
        Case "Failed"
            Lastrow = Sheets(Cells(i, "D").Value).Cells(Rows.Count, "D").End(xlUp).Row + 1
            Rows(i).Copy Sheets(Cells(i, "D").Value).Rows(Lastrow)

        End Select
Next
Application.ScreenUpdating = True
End Sub

 

[stressler]

Thank you 'My Answer is This'! This piece of the macro is working perfectly!!!! I still need my Not Testable and Passed pieces, but this piece is working great for the other sheets named exactly for what's shown in column D. Let me know if I can provide me details on those two sheets and their requirements or answer any questions to make it easier to figure out!

 

[MARK858]

Try the untested code below. I have assumed that where you have "N/A" in your description you meant "#N/A" as the result of a formula lookup (adjust if not).

Code assumes that you have headers on all columns on Data Sheet.

Sub stressler()
    Dim arr, i As Long
    arr = Array("Not Covered", "No Run", "Not Completed", "Blocked", "Failed")
    Application.ScreenUpdating = False
 
    With Sheets("Data Sheet").Range("A1:E" & Sheets("Data Sheet").Columns("A:E").Find("*", , xlValues, , xlByRows, xlPrevious).Row)
     
        For i = LBound(arr) To UBound(arr)
            .AutoFilter Field:=4, Criteria1:=arr(i)
            On Error Resume Next
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
            Debug.Print arr(i)
            Sheets(arr(i)).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
            On Error GoTo 0
            Sheets("Data Sheet").ShowAllData
        Next
     
        .AutoFilter 4, "#N/A"
        .AutoFilter 5, "<>"
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        Sheets("Not Testable").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
        On Error GoTo 0
        Sheets("Data Sheet").ShowAllData
     
        .AutoFilter 4, "#N/A"
        .AutoFilter 5, "="
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        Sheets("Passed").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
        On Error GoTo 0
        Sheets("Data Sheet").ShowAllData
     
        .AutoFilter 4, "Passed"
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        Sheets("Passed").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
        On Error GoTo 0
        .AutoFilter
     
        With Application
            .CutCopyMode = False
            .ScreenUpdating = True
        End With
 
    End With

End Sub