Collection Code error

[Juan Cornetto]

I am using the following code to create a unique sorted collection for populating a combobox in a user form but get a "Subscript out of range" error.

Can anyone spot the error please ?

Private Sub Worksheet_Activate()

Dim colMyCol As New Collection
Dim rRange As Range
Dim rCell As Range
Dim lCount As Long
Dim sVar As String

On Error GoTo ErrorHandle

Set rRange = Range("C1")

If Len(rRange.Value) = 0 Then GoTo BeforeExit

If Len(rRange.Offset(1, 0).Value) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If

On Error Resume Next

For Each rCell In rRange

If IsNumeric(rCell.Value) Then
sVar = Str$(rCell.Value)
Else
sVar = rCell.Value
End If

With colMyCol

If .Count > 0 Then
For lCount = 1 To .Count
If rCell.Value < .Item(lCount) Then
.Add rCell.Value, sVar, lCount
Exit For

End If
Next
End If

If lCount = .Count + 1 Or .Count = 0 Then
.Add rCell.Value, sVar
End If
End With
Next

On Error GoTo ErrorHandle

Set rRange = Range("P1")

With colMyCol
For lCount = 0 To .Count
rRange.Offset(lCount, 0).Value = .Item(lCount + 1)
Next
End With

BeforeExit:
Set colMyCol = Nothing
Set rRange = Nothing
Set rCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub

 

[RickXL]

Hi,

When I tried it the fault was here:

        For lCount = 0 To .Count
            rRange.Offset(lCount, 0).Value = .Item(lCount + 1)
        Next

There were 8 things in my list, items 1 to 8.
The loop runs from 0 to 8.
So lCount+1 runs from 1 to 9 but 9 is bigger than 8 so subscript out of range.

Try:

        For lCount = 0 To .Count - 1
            rRange.Offset(lCount, 0).Value = .Item(lCount + 1)
        Next

 

[Juan Cornetto]

Thanks Rick.
Tried that. Now I get 'Range' of object'_Global' failed

Is it significant that the range is dynamic ?