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