VBA - Search For Value Across Multiple Worksheets

[Steve Belsch]

Paulked,

I have attached the document with the VBA code. I believe I have included all of your suggestions and VBA code. It is now getting hung up on "Dim dic As New Scripting.Dictionary, kys() As Variant, ky As Variant, tm#".

Why would it get hung up on a Dim?

Thanks.
Steve

Sub DelPOs()    Dim arS1 As Variant, arS2 As Variant, lr As Long, i As Long, j As Long, sh As Worksheet
    Dim dic As New Scripting.Dictionary, kys() As Variant, ky As Variant, tm#
    tm = Timer
    'Get list of PO's to search for
    lr = Sheet("Accrual & PO Data").Cells(Rows.Count, 1).End(3).Row
    arS1 = Sheet("Accrual & PO Data").Range("A1:A" & lr)
    'Loop through sheets
    For Each sh In ThisWorkbook.Worksheets
        'Don't include PO Accrual Data
        
        
       If sh.Name <> "Instructions" And _
       sh.Name <> "Accrual & PO Data" And _
       sh.Name <> "Tab Name List" And _
       sh.Name <> "Subtotal Macro Button" And _
       sh.Name <> "Input Date" And _
       sh.Name <> "Summary FY19 F1(5)" And _
       sh.Name <> "Summary FY19 F1(4)" And _
       sh.Name <> "Summary FY19 F1(3)" And _
       sh.Name <> "Summary FY19 F1(2)" And _
       sh.Name <> "Summary FY19 F1" And _
       sh.Name <> "EP Local" And _
       sh.Name <> "Driver Definitions" And _
       sh.Name <> "EP Global" Then
           
        
        
      
            'Get list of PO's on current sheet
            lr = sh.Cells(Rows.Count, 1).End(3).Row
            If lr < 3 Then lr = 3 'There are blank sheets!
            arS2 = sh.Range("A1:A" & lr)
            'Loop through search PO's
            For i = 2 To UBound(arS1)
                'Loop through sheet PO's
                For j = 3 To UBound(arS2)
                    'If there is a PO match, add it to the dictionary if not already in there
                    If arS1(i, 1) = arS2(j, 1) Then
                        If Not dic.Exists(arS2(j, 1)) Then dic.Add arS2(j, 1), Nothing
                    End If
                Next
            Next
        End If
    Next
    'Loop through list to delete
    For i = UBound(arS1) To 2 Step -1
        'Loop through dictionary items
        For Each ky In dic.Keys
            'If there is a match. delete the PO row
            If Sheet("Accrual & PO Data").Cells(i, 1) = ky Then Sheet1.Rows(i).Delete shift:=xlUp
        Next
    Next
    'Show deleted PO's
    kys = dic.Keys
    If dic.Count <> 0 Then 'Can't print nothing!
        Sheet1.Range("E5").Resize(dic.Count) = Application.Transpose(kys)
    End If
    Sheet1.Range("E" & dic.Count + 6) = Timer - tm & " seconds to complete."
End Sub