About Us

Dave Peterson

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

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Application.Index & Application.Match	Antonio	Excel Programming	8	February 5th 07 02:13 PM
application.match	Chip Smith	Excel Discussion (Misc queries)	3	March 30th 06 08:56 PM
Application.Match	SIGE	Excel Programming	4	March 30th 05 03:06 PM
Application.Match	[email protected]	Excel Programming	0	September 2nd 04 12:07 AM
Application.Match	[email protected]	Excel Programming	0	September 1st 04 11:06 PM

Menu

About Us