Sorry, I misread your request.
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 = Sheet1.Cells(Rows.Count, 1).End(3).Row
arS1 = Sheet1.Range("A1:A" & lr)
'Loop through sheets
For Each sh In ThisWorkbook.Worksheets
'Don't include PO Accrual Data
If sh.Name <> "PO Accrual Data" 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 Sheet1.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!
Sheet4.Range("E5").Resize(dic.Count) = Application.Transpose(kys)
End If
Sheet4.Range("E" & dic.Count + 6) = Timer - tm & " seconds to complete."
End Sub