Consulting

Results 1 to 5 of 5

Thread: Need help with counters

  1. #1
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location

    Need help with counters

    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

  2. #2
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    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?

  3. #3
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    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.

  4. #4
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    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



    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  5. #5
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    Thanks everyone. Solved it myself!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •