Gautam Varma
New Member
I'm trying to create a macro to track defaulters in excel. For Step 1 I pull a list of Names and Email Subjects into an excel Workbook (Columns A & B Sheet1) from a particular Outlook Folder. In the same Excel Sheet I have a Master List of names in the second worksheet (Column A Sheet2). I want to compare the two and copy entire row data from the Master List Sheet of all those names that aren't present in Sheet1 (i.e. Defaulters or those who havent sent me an email). This is the code that i've tried so far. I have got it to highlight cells in Sheet2 but im unable to copy these highlighted cells dynamically into Sheet3. Could use some help! Thanks in Advance.
Code:
Option Explicit
Sub test()
Dim i As Long
Dim arrSum As Variant, arrUsers As Variant
Dim cUnique As New Collection
'Put the name range from "Summary" in an array
With ThisWorkbook.Sheets("Sheet2")
arrSum = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
'"Convert" the array to a collection (unique items)
For i = 1 To UBound(arrSum, 1)
On Error Resume Next
cUnique.Add arrSum(i, 1), CStr(arrSum(i, 1))
Next i
'Get the users array
With ThisWorkbook.Sheets("Sheet1")
arrUsers = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
End With
'Check if the value exists in the Users sheet
For i = 1 To cUnique.Count
'if can't find the value in the users range, delete the rows
If Application.WorksheetFunction.VLookup(cUnique(i), arrUsers, 1, False) = "#N/A" Then
With ThisWorkbook.Sheets("Sheet2").Cells
.AutoFilter Field:=1, Criteria1:=cUnique(i)
.Range("A2", .Range("A" & Rows.Count).End(xlUp)).EntireRow.Interior.ColorIndex = 35
End With
End If
Next i
'removes AutoFilter if one remains
ThisWorkbook.Sheets("Sheet2").AutoFilterMode = False
End Sub