What is the most number of consecutive colors.

Instead of picture please attach a sample workbook with enough data to make it clear what is needed. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are demonstrated, mock them up manually if needed. Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

How to install your new code

1. Copy the Excel VBA code
2. Select the workbook in which you want to store the Excel VBA code
3. Press Alt+F11 to open the Visual Basic Editor
4. Choose Insert > Module
5. Edit > Paste the macro into the module that appeared
6. Close the VBEditor
7. Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

Function GetMax(rMyRng As Range, iColor As Integer) As Long
Dim r As Range, lTemp As Long, lMax As Long

Application.Volatile True

For Each r In rMyRng
    If r.Font.ColorIndex = iColor Then
        lTemp = lTemp + 1
    Else
        If lTemp > lMax Then lMax = lTemp
        lTemp = 0
    End If
Next r

GetMax = lMax

End Function

=GetMax(Range,ColorNum)

=GetMax(E2:K2,3)

Hi, Sixthsense
You worked very hard.
A big thank you for that.

There are also data on this page. And they should be exempted.
To do this, your code. Buttons should work with.
Results area will be written: (B2: B. .....)
Where the area to be checked: (E2: K. ....)
I hope. It was understandable.

summary:
Macro should work with the button.
Work areas should be interfered with.
(B2: B. ...) and (E2: K. ....)

Sorry I am unable to understand your further requirement which you posted in Post #5

You can adjust the range and use the UDF formula at anywhere in the workbook.

I am ready to convert the UDF to macro but before that I just want to know what is the draw back having it in UDF?

Becuase I believe UDF is more flexible than the Macro code in this case.

Try this code…

Sub GetMax()
Dim iColor As Integer, lTemp As Long, lMax As Long, lEndRw As Long, i As Long
Dim rMyRng As Range, r As Range

lEndRw = Cells(Rows.Count, "E").End(xlUp).Row
Set rMyRng = Range("E1:K" & lEndRw)

For i = 2 To lEndRw
    For Each r In rMyRng.Rows(i).Cells
        If r.Font.ColorIndex = 3 Then
            lTemp = lTemp + 1
        Else
            If lTemp > lMax Then lMax = lTemp
            lTemp = 0
        End If
    Next r
    Cells(i, "B").Value = lMax
    lMax = 0
Next i

End Sub

To know the Number of the Font Color just place the cursor on that cell and Press Alt+F11 and Press Ctrl+G and copy paste the below code and hit enter.

?Activecell.Font.ColorIndex

Which will get you the color of the font (In which the cursor is placed)

In the below line of the provided code just replace the 3 (3 for red) to 1 (1 for black) with the number arrived in immediate window.

If r.Font.ColorIndex = 3 Then

@ pixel34,

If jindon's code gets the desired result then please stick with it for fine tuning

Because I don't want both of us (Me and Jindon) to spend much more time for this one unnecessarily. You may be enjoying the varieties but from my point of view your requirement is getting growing for each post of this thread when comparing to your initial thread

Oops... try try the below code for getting result for both Column-A (For Black Color Text) and Column-B (For Red Color Text)

Sub GetMax()
Dim iColor As Integer, lTemp As Long, lMax As Long, lEndRw As Long, i As Long
Dim rMyRng As Range, r As Range, x As Byte, sCol As String

lEndRw = Cells(Rows.Count, "E").End(xlUp).Row
Set rMyRng = Range("E1:K" & lEndRw)

For x = 1 To 2
    sCol = "A": iColor = -4105 'For Black
    If x = 2 Then sCol = "B": iColor = 3 'For Black
    
    For i = 2 To lEndRw
        For Each r In rMyRng.Rows(i).Cells
            If r.Font.ColorIndex = iColor Then
                lTemp = lTemp + 1
            Else
                If lTemp > lMax Then lMax = lTemp
                lTemp = 0
            End If
        Next r
        Cells(i, sCol).Value = lMax
        lTemp = 0
        lMax = 0
    Next i
Next x

End Sub

Dear Sixthsense,

I did the wrong test.
The first summer of the year, even if the macros incorrect.

if you don;
E: K is red all data from
value of "0" is doing.
Yet the value "7" will be.

It also handles empty cells will take.
(Empty cells will be traded.)
(Skip empty cells)


This macro message: 11

Sub GetMax()
Dim iColor As Integer, lTemp As Long, lMax As Long, lEndRw As Long, i As Long
Dim rMyRng As Range, r As Range

lEndRw = Cells(Rows.Count, "E").End(xlUp).Row
Set rMyRng = Range("E1:K" & lEndRw)

For i = 2 To lEndRw
    For Each r In rMyRng.Rows(i).Cells
        If r.Font.ColorIndex = 3 Then
            lTemp = lTemp + 1
        Else
            If lTemp > lMax Then lMax = lTemp
            lTemp = 0
        End If
    Next r
    Cells(i, "B").Value = lMax
    lMax = 0
Next i

End Sub

Try this...

Sub GetMax()
Dim iColor As Integer, lTemp As Long, lMax As Long, lEndRw As Long, i As Long
Dim rMyRng As Range, r As Range, x As Byte, sCol As String

lEndRw = Cells(Rows.Count, "E").End(xlUp).Row
Set rMyRng = Range("E1:K" & lEndRw)

For x = 1 To 2
    sCol = "A": iColor = -4105 'For Black
    If x = 2 Then sCol = "B": iColor = 3 'For Black
    
    For i = 2 To lEndRw
        For Each r In rMyRng.Rows(i).Cells
            If r.Value <> "" Then
                If r.Font.ColorIndex = iColor Then
                    lTemp = lTemp + 1
                Else
                    If lTemp > lMax Then lMax = lTemp
                    lTemp = 0
                End If
            End If
        Next r
        Cells(i, sCol).Value = lMax
        lTemp = 0
        lMax = 0
    Next i
Next x

End Sub

This is a great code.
Dear Sixthsense
I'm doing the following experiment.

Glad it helps you and thanks for the feedback

Try this final version of code...

Sub GetMax()
Dim iColor As Integer, lTemp As Long, lMax As Long, lEndRw As Long, i As Long
Dim rMyRng As Range, r As Range, x As Byte, sCol As String

lEndRw = Cells(Rows.Count, "E").End(xlUp).Row
Set rMyRng = Range("E1:K" & lEndRw)

For x = 1 To 2
    sCol = "A": iColor = -4105 'For Black
    If x = 2 Then sCol = "B": iColor = 3 'For Black
    
    For i = 2 To lEndRw
        For Each r In rMyRng.Rows(i).Cells
            If r.Value <> "" Then
                If r.Font.ColorIndex = iColor Then
                    lTemp = lTemp + 1
                Else
                    lTemp = 0
                End If
            Else
                lTemp = 0
            End If
            If lTemp > lMax Then lMax = lTemp
        Next r
        Cells(i, sCol).Value = lMax
        lTemp = 0
        lMax = 0
    Next i
Next x

End Sub

Refer the attached file for details. If it gets any wrong results then please highlight those rows with expected result

Please attach a file with code and highlight the wrong result with expected answer

Try this revised code...

Sub GetMax()
Dim iColor As Integer, lTemp As Long, lMax As Long, lEndRw As Long, i As Long
Dim rMyRng As Range, r As Range, x As Byte, sCol As String

lEndRw = Cells(Rows.Count, "E").End(xlUp).Row
Set rMyRng = Range("E1:K" & lEndRw)

For x = 1 To 2
    sCol = "A": iColor = 0 'For Black
    If x = 2 Then sCol = "B": iColor = 255 'For Black
    
    For i = 2 To lEndRw
        For Each r In rMyRng.Rows(i).Cells
            If r.Value <> "" Then
                If r.Font.Color = iColor Then
                    lTemp = lTemp + 1
                Else
                    lTemp = 0
                End If
            Else
                lTemp = 0
            End If
            If lTemp > lMax Then lMax = lTemp
        Next r
        Cells(i, sCol).Value = lMax
        lTemp = 0
        lMax = 0
    Next i
Next x

End Sub

Refer the attached file for details

You're Welcome

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.