Need help with counters

[austenr]

Could someone take a look at this code and help me with my counters. Counters are counter1 and counter2. What I want is toi count every time a row is written to Sheet3. Thanks in advance.


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

[Zack Barresse]

Maybe try putting at the beginning of your code ..

counter1 = 1
counter2 = 1
Are you getting an error? What does the msgbox say at the end? Have you stepped through your code w/ F8?

[austenr]

I am not getting an error but when testing I did not come up with the expected count. Thought I was putting them in the wrong place.

[mdmackillop]

Hi Austen,
There's no counter in the upper part of your code. Could this be the problem


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

[austenr]

Thanks everyone. Solved it myself!!