Sub ListOutOfStock()
Dim LastRow, LastRow2 As Long
Dim rw, n As Long
Dim cnt, cnt1 As Integer
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For rw = 2 To LastRow
cnt = 0
cnt1 = 0
For n = rw To LastRow
If n = rw Then GoTo SkipThisRow 'Don't count this row
If Cells(n, 1) = Cells(rw, 1) Then
cnt1 = cnt1 + 1 'cnt1 keeps total of same sku found
If Cells(rw, 4) = "" Or Cells(rw, 4) = 0 And Cells(n, 4) = "" Or Cells(n, 4) = 0 Then
cnt = cnt + 1 'Keeps total of each sku with zero stock
End If
End If
SkipThisRow:
Next n
LastRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
If cnt = cnt1 And cnt <> 0 Then Sheets("Sheet2").Cells(LastRow2, 1) = Sheets("Sheet1").Cells(rw, "A")
Next rw
Sheets("Sheet2").Activate
'The macro called below will eliminate any duplicate skus on Sheet2
Call OnlyOneSKU
Application.ScreenUpdating = True
MsgBox "Out of Stock Listing is Complete"
End Sub
Sub OnlyOneSKU()
Dim Rng As Range
Dim LastRow As Long
Dim i As Long
Dim sDupColumn As String
sDupColumn = "A"
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range("A1:A" & LastRow)
'The following 'With' statement will sort the SKUs - I commented it out, but it can be used by removing the single quotes - Try running the rest of the code first with it commented out.
'With Rng
'.Sort key1:=Range(sDupColumn & 1), order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
'Orientation:=xlTopToBottom
'End With
For i = LastRow To 2 Step -1
If WorksheetFunction.CountIf(Range(Cells(2, sDupColumn), Cells(i, sDupColumn)), Cells(i, sDupColumn)) > 1 Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
