If you want the two categories completely isolated, ie. Duplicates one sheet, non-duplicated items another sheet then
Sub t2()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, c As Range
Set sh1 = Sheets("Sheet1") 'Edit sheet names
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
sh1.UsedRange.Copy sh2.Range("A1")
sh2.Range("A1", sh2.Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter xlFilterInPlace, , , True
For Each c In sh2.Range("A1", sh2.Cells(Rows.Count, 1).End(xlUp))
If sh2.Rows(c.Row).Hidden Then
sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
End If
Next
sh2.ShowAllData
For i = sh2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Application.CountIf(sh3.Range("A1", sh3.Cells(Rows.Count, 1).End(xlUp)), sh2.Cells(i, 1).Value) = 0 Then
sh2.Cells(i, 1).EntireRow.Delete
End If
Next
sh3.Cells.Clear
sh1.Rows(1).Copy sh3.Range("A1")
For Each r In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
If Application.CountIf(sh2.Range("A2", sh2.Cells(Rows.Count, 1).End(xlUp)), r.Value) = 0 Then
r.EntireRow.Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next
End Sub
If you have a large file, this might take a while to run because of the loops. I tried to make it a fast as I knew how, but my knowledge is limited.
Bookmarks