The problem could still be in the data.

" wrote:

Hi Everyone,

Thanks for the tips and suggestions.

Here is the code.

Option Explicit
Const AD_EMP_ID_COL = 1

Private Sub TestCompare()
Dim book As Workbook
Set book = ActiveWorkbook
Compare book
End Sub

Sub Compare(book As Workbook)

Application.StatusBar = "Creating Matches/Unmatches"

Dim Match As Long
Dim UnMatch1 As Long
Dim i As Long
Dim n As Long

Dim ad As Worksheet
Dim ps As Worksheet
Dim Matches As Worksheet
Dim unmatches As Worksheet

Dim ADKeyRng As Range
Dim PSKeyRng As Range

Dim res As Variant
Dim myCell As Range

Dim sv As String
Set ad = Worksheets("ActiveDirectory")
Set ps = Worksheets("People")
Set Matches = Worksheets("Matches")
Matches.Cells.Clear
Set unmatches = Worksheets("UnMatches")
unmatches.Cells.Clear

Set PSKeyRng = ps.Range("A1", "A" + Format(RowCount(ps, "A1")))
'Address of PSKeyRng looks something like "A1:A18000"

Match = 1
UnMatch1 = 1
Dim count As Long
count = 1
n = FindLastRowNumber(ad, "samAccountName")
For i = 1 To n
res = Application.Match(Trim(ad.Cells(i, AD_EMP_ID_COL).Value),
PSKeyRng, 0)
'res doesn't return Error for Cells starting with "C000"
'I took out the if statement to use different versions of
Application.Match to keep code easy to read
If IsError(res) Then
ad.rows(i).Copy Destination:=unmatches.rows(UnMatch1)
UnMatch1 = UnMatch1 + 1
Else
ad.rows(i).Copy Destination:=Matches.rows(Match)
Match = Match + 1
End If
Next i
End Sub

Function RowCount(sheet As Worksheet, rname As String) As Long
sheet.Activate
sheet.Range(rname).Select
Range(Selection, Selection.End(xlDown)).Select
If 65536 < Selection.Cells.count Then
RowCount = Selection.Cells(Selection.Cells.count).row
Else
RowCount = 0
End If
End Function

Function FindLastRowNumber(sheet As Worksheet, colName As String) As
Long
Dim col As Long
col = FindColumnNumber(sheet, colName)
sheet.Activate
sheet.Cells(1, col).Select
Range(Selection, Selection.End(xlDown)).Select
FindLastRowNumber = Selection.rows.count
End Function

--

Dave Peterson