Infinite loop? Help.
I am trying to get some code to work and I think it goes into an infinite loop. Can anyone tell me what I am doing wrong? Code follows:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aNames As Collection
Dim bNames As Collection
Dim c As Range
Dim rng As Range
Dim iCt As Integer
Dim iRow As Integer
Dim Ct As Integer
On Error Resume Next
For iRow = 3 To 37 Step 2
Set aNames = New Collection
Set bNames = New Collection
Set rng = Sheets("Tracker").Range("G" & iRow & ":CI" & iRow)
For Each c In rng
Debug.Print c.Address
For Ct = 1 To 18
If c.Value = Sheets("Weekly Sched").Cells(Ct + 4, 10) Then
aNames.Add c.Value, c.Value
End If
Next Ct
If aNames.Count = 0 Then
bNames.Add c.Value, c.Value
End If
Next c
Sheets("Tracker").Cells(iRow - 1, 4) = aNames.Count
Sheets("Tracker").Cells(iRow, 4) = bNames.Count
Sheets("Test").Cells((iRow - 1) / 2 + 4, 6) = aNames.Count + bNames.Count
Set aNames = Nothing
Set bNames = Nothing
Next iRow
End Sub
|