I see there are many replies but the details have not been uploaded.
Christmas Eh?

Here is another solution, perhaps this will be uploaded.

Sub test()
Dim c As Variant, d As Variant
Dim left2 As String
Dim x() As Variant
Dim vaX() As Variant
Dim bIsUnique As Boolean
Dim iCodeCount As Variant
Dim sCode As String
Dim iIndex As Integer
Dim Inti As Integer
Dim nUnique As Integer
Dim nx As Integer
Dim wks As Worksheet
Dim rngDest As Range
Dim rngSource As Range

nx = 0
Set rngSource = Range(Selection.Address)
For Each c In rngSource
bIsUnique = False
If Not IsEmpty(c) Then
sCode = Left(c, 2)
End If
For iIndex = 1 To nUnique
If sCode = x(iIndex) Then
bIsUnique = True
GoTo AddCode 'Exit For Next loop
End If
Next iIndex
'Create unique array of codes
AddCode:
If Not bIsUnique And Not IsEmpty(sCode) Then
nUnique = nUnique + 1
ReDim Preserve x(nUnique)
x(nUnique) = sCode
End If

Next c
' enter the types in column 4
For iIndex = 1 To UBound(x)
Cells(iIndex, 4) = x(iIndex)
Next iIndex

Set rngDest = Range(Cells(1, 4), Cells(nUnique, 4))
' enter the cont of types in column 5
For Each d In rngDest
iCodeCount = 0
For Each c In rngSource
sCode = Left(c, 2)
If CStr(d) = CStr(sCode) Then
iCodeCount = iCodeCount + 1
End If
Next c

d.Offset(0, 1) = iCodeCount

Next d

End Sub

Regards
Peter Atherton


"Phuelgod" wrote:

Hello folks,

I've got a runtime error 6 on the following line of code:

For k = 2 To j

local values a
k = 23468
j = 32933

both are declared integers

In a nutshell, the code find out how many rows of data there are, then goes
through each row to count the data by type (Select Case Left(Cells(k,2),2)).

Is there a limit to iterations on a for...next loop?

Any help troubleshooting this will be appreciated

Thanks!

Frank