Run-time error '91"- bypass and add comment

[JMC88]

Hello,
I have encountered an error on my macro. I have a macro set up to filter data on one tab (Open POs Finance) and look for items that are "Not Accrued" in a certain column and then copy and paste them into a table on another tab (Critique). This works perfectly. However; when there are no "Not Accrued" items on the Open POs tab, then the macro returns a Run-time error 91. I am hoping to insert a condition that if there are no "Not Accrued" items on the Open POs tab, then it instead reverts the spreadsheet back (protected and unfiltered), and adds a note on cell A26 in the Critique tab saying "No POs Found". I have tried searching for a way to add this bypass in, but I have not been able to locate anything. Is anyone able to offer any guidance?

Sub CopyData()
    Sheets("Critique").Select
    Range("A26:H55").Select
    Selection.ClearContents
    Range("A1").Select
   
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, colArr As Variant, lRow As Long
    colArr = Array("B", "A", "E", "B", "F", "C", "H", "D", "J", "E", "K", "F", "M", "G")
    Set desWS = Sheets("Critique")
    Set srcWS = Sheets("Open POs Finance")
    Worksheets("Open POs Finance").Unprotect
    With srcWS
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A11").CurrentRegion.AutoFilter 16, desWS.Range("A24").Value
        For i = LBound(colArr) To UBound(colArr) Step 2
            Intersect(.Rows("11:" & lRow), .Range(colArr(i) & 2 & ":" & colArr(i) & lRow).SpecialCells(xlCellTypeVisible)).Copy
            desWS.Cells(desWS.Rows.Count, colArr(i + 1)).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        Next i
        .Range("A11").AutoFilter
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Worksheets("Open POs Finance").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
   
    Range("A1").Select
End Sub

Thank you in advance!

 

[Michael M]

UNTESTED

With srcWS
lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If Application.WorksheetFunction.CountIf("A:A", "Not Accrued") = 0 Then
.protect......the rest of your code
end with
desWS.range"A26").value="No PO's Found"

 

[Peter_SSs]

@JMC88
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

 

[Alex Blakenburg]

Just putting @Michael M solution in context and making a couple of other changes:
Comments
• I don't see what value intersect adds over just starting your range from 11 instead of 2
• I have left your original 4 lines but based on the initial clearcontents there seems little value in getting the last row of the destination sheet since it is clearly meant to be row 26

Sub CopyData_mod()

    Sheets("Critique").Select
    Range("A26:H55").Select
    Selection.ClearContents
    Range("A1").Select
   
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, colArr As Variant, lRow As Long
    Dim srcRng As Range                        
    Dim i As Long                            
    colArr = Array("B", "A", "E", "B", "F", "C", "H", "D", "J", "E", "K", "F", "M", "G")
    Set desWS = Sheets("Critique")
    Set srcWS = Sheets("Open POs Finance")
    srcWS.Unprotect
    With srcWS
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If Application.WorksheetFunction.CountIf(.Range(.Cells(11, 16), .Cells(lRow, 16)), desWS.Range("A24").Value) > 0 Then
            .Range("A11").CurrentRegion.AutoFilter 16, desWS.Range("A24").Value
        
            For i = LBound(colArr) To UBound(colArr) Step 2
                .Range(colArr(i) & 11 & ":" & colArr(i) & lRow).SpecialCells(xlCellTypeVisible).Copy
                desWS.Cells(desWS.Rows.Count, colArr(i + 1)).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Next i
            .Range("A11").AutoFilter
            Application.CutCopyMode = False
        End If

    End With

    Application.ScreenUpdating = True
    srcWS.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
   
    Range("A1").Select
End Sub