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

A hypothesis is that you have this EVENT procedure in the
code module for the sheet Tracker or Test. With the name
of the procedu
Private Sub Worksheet_Change(ByVal Target As Range)
and having these lines in it:
Sheets("Tracker").Cells(iRow - 1, 4) = aNames.Count
Sheets("Tracker").Cells(iRow, 4) = bNames.Count
Sheets("Test").Cells((iRow - 1) / 2 + 4, 6) = . . .
the procedure will be initiated again whenever it hits one
of these lines. I suspect you should put the code (with a
different name) in a separate module (not a worksheet
module).

HTH,
Merjet

That was the problem. I don't know why I couldn't see that. Thanks.

"merjet" wrote:

A hypothesis is that you have this EVENT procedure in the
code module for the sheet Tracker or Test. With the name
of the procedu
Private Sub Worksheet_Change(ByVal Target As Range)
and having these lines in it:
Sheets("Tracker").Cells(iRow - 1, 4) = aNames.Count
Sheets("Tracker").Cells(iRow, 4) = bNames.Count
Sheets("Test").Cells((iRow - 1) / 2 + 4, 6) = . . .
the procedure will be initiated again whenever it hits one
of these lines. I suspect you should put the code (with a
different name) in a separate module (not a worksheet
module).

HTH,
Merjet

Or disable events before executing statements that change cells, i.e.

Application.EnableEvents = False

On Sat, 31 Jul 2004 20:03:02 -0700, "Erik"
wrote:

That was the problem. I don't know why I couldn't see that. Thanks.

"merjet" wrote:

A hypothesis is that you have this EVENT procedure in the
code module for the sheet Tracker or Test. With the name
of the procedu
Private Sub Worksheet_Change(ByVal Target As Range)
and having these lines in it:
Sheets("Tracker").Cells(iRow - 1, 4) = aNames.Count
Sheets("Tracker").Cells(iRow, 4) = bNames.Count
Sheets("Test").Cells((iRow - 1) / 2 + 4, 6) = . . .
the procedure will be initiated again whenever it hits one
of these lines. I suspect you should put the code (with a
different name) in a separate module (not a worksheet
module).

HTH,
Merjet

Hi
at the beginning of your code add:
application.enableevents=false

and at the end
application.enableevents=True

BUT: I'm not so sure why you run this code each time a value is changed
in your sheet?


--
Regards
Frank Kabel
Frankfurt, Germany


Erik wrote:
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

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 goto ErrHandler

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
On Error Resume Next
aNames.Add c.Value, c.Value
On Error goto ErrHandler
End If
Next Ct
If aNames.Count = 0 Then
On Error Resume Next
bNames.Add c.Value, c.Value
On Error goto ErrHandler
End If
Next c
Application.EnableEvents = False
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
ErrHandler:
Application.EnableEvents = True
End Sub

--
Regards,
Tom Ogilvy

"Erik" wrote in message
...
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