Sleeper: Need to modify this Routine

[austenr]

I use this Subroutine to match numbers but now I need to modify it to match a string. Any help is greatly appreciated.


Public Sub CheckCells()
Dim counter1 As Integer, counter2 As Integer
Dim varS1, varS2, varH1, varH2
Dim rngS1 As Range, rngS2 As Range
Dim c As Range, c1 As Range, c2 As Range
Dim iRow As Integer, iCol As Integer, i As Integer, iTest As Integer
' Application.ScreenUpdating = False
Sheet1.Activate
Set rngS1 = Intersect(Sheet1.UsedRange, Columns("A"))
Sheet2.Activate
Set rngS2 = Intersect(Sheet2.UsedRange, Columns("A"))
Sheet3.Activate
Let iRow = iRow + 2
With rngS2
'Search for Sheet1 AU IDs on Sheet2
For Each c1 In rngS1
On Error GoTo 0
Set c = .Find(what:=c1.Value) 'Look for match
If c Is Nothing Then 'Copy the SS# to Sheet3
On Error Resume Next
Sheet3.Cells(iRow, 1) = c1
Let iRow = iRow + 1
Else 'Check if rows are identical
Let varS1 = Intersect(Sheet1.UsedRange, c1.EntireRow)
Let varS2 = Intersect(Sheet2.UsedRange, c.EntireRow)
Let iCol = Intersect(Sheet1.UsedRange, c1.EntireRow).Count
ReDim varH1(1 To iCol) As Integer
For i = 1 To iCol
If Not varS1(1, i) = varS2(1, i) Then
On Error Resume Next
Let iTest = iTest + 1
Let varH1(i) = 1
End If
Next i
If iTest Then 'Rows are not identical
For i = 1 To iCol
Sheet3.Cells(iRow, i) = varS1(1, i)
If Not varH1(i) = 0 Then Cells(iRow, i) _
.Interior.ColorIndex = 36
Next i
Let iTest = 0
Let iRow = iRow + 1
End If
End If
Next
End With
Let iRow = iRow + 2
With rngS1
'Search for Sheet2 SS# IDs on Sheet1
For Each c2 In rngS2
On Error GoTo 0
Set c = .Find(what:=c2.Value) 'Look for match
If c Is Nothing Then 'Copy the SS# to Sheet3
Sheet3.Cells(iRow, 1) = c2
counter1 = counter1 + 1
Let iRow = iRow + 1
Else 'Check if rows are identical
Let varS1 = Intersect(Sheet2.UsedRange, c2.EntireRow)
Let varS2 = Intersect(Sheet1.UsedRange, c.EntireRow)
Let iCol = Intersect(Sheet2.UsedRange, c2.EntireRow).Count
ReDim varH2(1 To iCol) As Integer
For i = 1 To iCol
On Error Resume Next
If Not varS1(1, i) = varS2(1, i) Then
Let iTest = iTest + 1
Let varH2(i) = 1
End If
Next i
If iTest Then 'Rows are not identical
For i = 1 To iCol
Sheet3.Cells(iRow, i) = varS1(1, i)
counter2 = counter2 + 1
If Not varH2(i) = 0 Then Cells(iRow, i) _
.Interior.ColorIndex = 36
Next i
Let iTest = 0
Let iRow = iRow + 1
End If
End If
Next
End With
'Application.ScreenUpdating = True
'MsgBox "Counter 1: " & counter1 & vbCrLf & _
'"Counter 2: " & counter2 & vbCrLf & vbCrLf
End Sub

[austenr]

More information, Sheet1 and Sheet2 have a last name in Column A and a first name in Column B Sheet3 should show the no matches. Thanks