Searching two ranges

[Ken Warthen]

I'm trying to iterate through range on one worksheet, and then look for a
matching name on a second worksheet where a count would be added when there's
a match. My code follows, but it's generating a Next without For error
message. Any help straightening this out would be hugely appreciated.

Ken

Public Sub sUpdateCollegeCounts()
On Error GoTo 0
Dim strCollege As String
Dim lngCount As Long
Dim Cell As Range
Dim Cell2 As Range

With ThisWorkbook.Worksheets("Respondent Profile")
For Each Cell In Range("RespondentID")
If Len(Cell.Offset(0, 1)) > 0 Then
strCollege = Cell.Offset(0, 1)
Else
strCollege = "No college or non-response"
End If
Worksheets("Response by College").Activate
For Each Cell2 In Range("hColleges")
If Cell.Value = strCollege Then
Cell.Offset(1, 0) = Cell.Offset(1, 0).Value + 1
Next Cell2
Worksheets("Respondent Profile").Activate
Next Cell
End With

PROC_EXIT:
Exit Sub
End Sub

 

[RB Smissaert]

Try this:

Public Sub sUpdateCollegeCounts()

On Error GoTo 0
Dim strCollege As String
Dim lngCount As Long
Dim Cell As Range
Dim Cell2 As Range

With ThisWorkbook.Worksheets("Respondent Profile")
For Each Cell In Range("RespondentID")
If Len(Cell.Offset(0, 1)) > 0 Then
strCollege = Cell.Offset(0, 1)
Else
strCollege = "No college or non-response"
End If
Worksheets("Response by College").Activate
For Each Cell2 In Range("hColleges")
If Cell.Value = strCollege Then
Cell.Offset(1, 0) = Cell.Offset(1, 0).Value + 1
End If
Next Cell2
Worksheets("Respondent Profile").Activate
Next Cell
End With

PROC_EXIT:
Exit Sub
End Sub


RBS

 

[Ken Warthen]

Thanks. That got me back on track.

Ken

Try this:

Public Sub sUpdateCollegeCounts()

On Error GoTo 0
Dim strCollege As String
Dim lngCount As Long
Dim Cell As Range
Dim Cell2 As Range

With ThisWorkbook.Worksheets("Respondent Profile")
For Each Cell In Range("RespondentID")
If Len(Cell.Offset(0, 1)) > 0 Then
strCollege = Cell.Offset(0, 1)
Else
strCollege = "No college or non-response"
End If
Worksheets("Response by College").Activate
For Each Cell2 In Range("hColleges")
If Cell.Value = strCollege Then
Cell.Offset(1, 0) = Cell.Offset(1, 0).Value + 1
End If
Next Cell2
Worksheets("Respondent Profile").Activate
Next Cell
End With

PROC_EXIT:
Exit Sub
End Sub


RBS