Suma continua de colores

Explícate un poco más.

Si me das una dirección de correo te mando hoja y te lo puedo explicar mejor, porque es un poco enrevesado.
¡ Muchas gracias ¡

[email protected]

Recibí tu correo (disculpa la tardanza). Si supiera el numero de colores y cuantas filas y columnas vas a utilizar podría hacerte el código y que se activara al clickar una commandbutton. Necesitaría también saber donde quieres que salgan los resultados

Perdona si soy un poco pesado.
Lo que quiero es que me marque cada tramo de color con un número.
El máximo de tramos por color es de 5. Así se puede marcar el color rojo por ejemplo del 1 al 5, el azul del 10 al 25, el verde del 30 al 35, el gris del 40 al 45 y el blanco del 50 al 55. No necesito que me las cuente directamente, porque luego tengo que hacer una estadística por filas y ya las cuento yo como me interese.
¡Muchas gracias !

Te acabo de enviar el correo de respuesta.

¡ HOLA !
Recibí tu correo, y he aplicado algunas modificaciones al código que me mandaste, pero no funciona. revisamelo. (No sé si te habrás dado cuenta, pero no soy muy ducho, en esto de las madros)
Option Explicit
Sub contarcolores()
    Const celdaInicial = "B2"
    Const celdaFinal = "IRJ16"
    Dim miRango As Range
    Dim i As Integer
    Dim j As Integer
    Dim val1 As String
    Dim val2 As String
    Dim nuevoColor As String
    Dim nColor As Integer
    Dim CONT As Integer
    Dim X As Integer
    Dim y As Integer
    Dim RESULTADO3 As Integer
    Dim RESULTADO2 As Integer
    Dim RESULTADO15 As Integer
    Set miRango = ActiveSheet.Range(celdaInicial & ":" & celdaFinal)
    i = 0
    j = 0
'cuento las columnas con colores
Do Until Cells(1, i + 1).Interior.ColorIndex = xlNone
    i = i + 1
Loop
'cuento las filas con colores
Do Until Cells(j + 1, 1).Interior.ColorIndex = xlNone
    j = j + 1
Loop
'Entiendo que el resto de casillas que no nos interesen NO tendrán relleno
CONT = 1
For X = 1 To i
    For y = 1 To j
        If Cells(y, X).Interior.ColorIndex = Cells(y + 1, X).Interior.ColorIndex Then
        'Comparo la celda actual con la siguiente
            CONT = CONT + 1
            'Si son iguales incremento un contador
        Else
            'El color de la celda actual y la siguiente no son iguales
            If CONT = 1 Then
            'No se han encontrado dos colores consecutivos
            Else
                Select Case Cells(y, X).Interior.ColorIndex
                    Case 3
                        If RESULTADO3 = "" Then
                            RESULTADO3 = CONT
                        Else
                            RESULTADO3 = RESULTADO3 & "-" & CONT
                        End If
                        'Voy encadenando en la variable resultado3 (resultado de las casillas color rojo) el numero de colores consecutivos encontrados (cont)
                    Case 6
                        If RESULTADO2 = "" Then
                            RESULTADO2 = CONT
                        Else
                            RESULTADO2 = RESULTADO2 & "-" & CONT
                        End If
                    Case 15
                        If RESULTADO15 = "" Then
                            RESULTADO15 = CONT
                        Else
                            RESULTADO15 = RESULTADO15 & "-" & CONT
                        End If
                        'Lo mismo pero para el color gris
                End Select
                CONT = 1
            End If
        End If
    Next y
    'He terminado de buscar en una columna
    If RESULTADO3 = "" Then RESULTADO3 = "0"
    If RESULTADO2 = "" Then RESULTADO2 = "0"
    If RESULTADO15 = "" Then RESULTADO15 = "0"
    'Estas ordenes es para que no te salga el resultado en blanco si no hay consecutivos
    Cells(j + 2, X) = "ROJO: " & RESULTADO3
    Cells(j + 3, X) = "AMARILLO: " & RESULTADO2
    Cells(j + 4, X) = "GRIS: " & RESULTADO15
    'Coloca el resultado de lo que hemos encontrado al final de la columna
    RESULTADO3 = ""
    RESULTADO2 = ""
    RESULTADO15 = ""
    'Inicializo los mensajes de resultado
Next X
End Sub