Note my example assumes that the first dimension of the array (i.e. the
numbers) are always entered in sequential groupings (i.e. 1 1 1 1 1, 2 2 2 2
2, 3 3 3 3 3, 4 4 4 4 4 etc). Its the colours in the second dimension which
are random.

Thanks

EM

"ExcelMonkey" wrote:

Thanks I will give it a look. I threw this together in the mean time. Not
sure if its error proof. It seems to work but I have not tested it
thoroughly.

EM

Sub FindMaxMatches()
Dim TheArray As Variant
Dim ArrayLimitsArray As Variant

ReDim TheArray(0 To 1, 0 To 10)
ReDim ArrayLimitsArray(0 To 1, 0 To 0)
ReDim ResultArray(0 To 1, 0 To 0)

TheArray(0, 0) = 1
TheArray(0, 1) = 1
TheArray(0, 2) = 1
TheArray(0, 3) = 1
TheArray(0, 4) = 1
TheArray(0, 5) = 1
TheArray(0, 6) = 2
TheArray(0, 7) = 2
TheArray(0, 8) = 2
TheArray(0, 9) = 2
TheArray(0, 10) = 2

TheArray(1, 0) = "Red"
TheArray(1, 1) = "Red"
TheArray(1, 2) = "Blue"
TheArray(1, 3) = "Blue"
TheArray(1, 4) = "Blue"
TheArray(1, 5) = "Green"
TheArray(1, 6) = "Green"
TheArray(1, 7) = "Green"
TheArray(1, 8) = "Blue"
TheArray(1, 9) = "Green"
TheArray(1, 10) = "Blue"

MinFound = 0
StartValue = TheArray(0, 0)
Counter = 0

'Set Bounds of Search
'by tacking occurences of numbers
For x = 1 To UBound(TheArray, 2)
If TheArray(0, x) = StartValue Then
MaxFound = x
If x = UBound(TheArray, 2) Then
ArrayLimitsArray(0, Counter) = MinFound
ArrayLimitsArray(1, Counter) = MaxFound
Debug.Print ArrayLimitsArray(0, Counter) & ":" &
ArrayLimitsArray(1, Counter)
End If
Else
ArrayLimitsArray(0, Counter) = MinFound
ArrayLimitsArray(1, Counter) = MaxFound
Debug.Print ArrayLimitsArray(0, Counter) & ":" & ArrayLimitsArray(1,
Counter)
MinFound = MaxFound + 1
Counter = Counter + 1
StartValue = TheArray(0, MaxFound + 1)
ReDim Preserve ArrayLimitsArray(0 To 1, 0 To Counter)
End If
Next

'Search Array based on
'bounds found in previous code
Counter = 0
Counter2 = 0
Counter3 = 0
temp = 0
For x = 1 To UBound(ArrayLimitsArray, 1) + 1
For Y = ArrayLimitsArray(0, x - 1) To ArrayLimitsArray(1, x - 1)
For z = ArrayLimitsArray(0, x - 1) To ArrayLimitsArray(1, x - 1)
If Y < ArrayLimitsArray(1, x - 1) Then

StartValue = TheArray(1, Counter3)

If StartValue = TheArray(1, z) Then
Counter = Counter + 1
CurrentCounter = Counter
Else
PreviousCounter = Counter
Counter = 0
CurrentCounter = 0
'If a Match does not occur
'pass Counter to temp variable
'if counter than temp variable
'this will allo you to keep max counter
'in memory
If temp1 < PreviousCounter Then
temp1 = PreviousCounter
temp2 = TheArray(1, Y)
temp3 = TheArray(0, Y)
End If
End If
Else
If temp1 < CurrentCounter Then
temp1 = CurrentCounter
temp2 = TheArray(1, Y)
temp3 = TheArray(0, Y)
End If

ResultArray(0, Counter2) = temp3
ResultArray(1, Counter2) = temp1 & ":" & temp2
Debug.Print ResultArray(0, Counter2) & "," & ResultArray(1,
Counter2)
Counter = 0
Counter2 = Counter2 + 1
ReDim Preserve ResultArray(0 To 1, 0 To Counter2)
temp1 = 0
temp2 = ""
temp3 = ""
Exit For
End If
Next
Counter3 = Counter3 + 1
Next
Next
End Sub


"RB Smissaert" wrote:

See this recent thread in VB6:
http://groups.google.co.uk/group/mic...b48649b610e418

RBS

"ExcelMonkey" wrote in message
...
Does anyone know of a function which allows you to track the maximum count
of
items in an array? Lets say I have an array with repeating data (See
below).
I want to be able to track which item occurs the most # of times. The
answer below would be 3 occurences of the letter "a". I know I could buld
a
loop which tests each items against the data set and use a counter and
temp
variable to track and store the Max# of occurences. But is there a
combination of functions that would do the same?

TheArray(0) = "a"
TheArray(1) = "b"
TheArray(2) = "a"
TheArray(3) = "c"
TheArray(4) = "c"
TheArray(5) = "d"
TheArray(6) = "a"

Thanks