the color of cells

[idnoidno]

If the 2 numbers are oblique, the cells are displayed red, if the 3 numbers are oblique, the cells are displayed brown, if the 4 or more numbers are oblique, the cells are displayed blue.I want to get the results as shown in the worksheet cell.I have been thinking for several days, but still do not know how to solve, I hope someone can guide the method.I will be very grateful.


0000.xlsx

[p45cal]

Try the attached.

[mdmackillop]

Sub Test()
    Dim r As Range, Res As Range, cel As Range
    Dim i&, j&
    Set r = Range("K6").CurrentRegion.Offset(1)
    r.Cells.Interior.ColorIndex = xlNone
    Application.ScreenUpdating = False
    For Each cel In r
        If cel.Interior.ColorIndex = xlNone Then
            Set Res = Nothing: i = 1: j = 2
            If cel.Offset(i, j) = cel + 2 Then
                Set Res = Union(cel, cel.Offset(i, j))
                Do
                    i = i + 1: j = j + 2
                    If cel.Offset(i, j) = cel + (2 * i) Then
                        Set Res = Union(Res, cel.Offset(i, j))
                    Else
                        Exit Do
                    End If
                Loop
                Select Case i
                Case 2
                    Res.Interior.ColorIndex = 3
                Case 3
                    Res.Interior.ColorIndex = 9
                Case Else
                    Res.Interior.ColorIndex = 5
                End Select
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[MickG]

Another option:-

Sub Colorcell()
Dim Rng As Range, Dn As Range, nRng As Range, Temp As Range, col As Integer, t
Set Rng = Range("K7:AQ2139")
For Each Dn In Rng
    If Not IsEmpty(Dn.Value) And Dn.Interior.ColorIndex = xlNone Then
        Set nRng = Dn
             
            Do While Not IsEmpty(Dn.Offset(1, 2).Value) And Dn.Offset(1, 2).Interior.ColorIndex = xlNone
               Set nRng = Union(nRng, Dn.Offset(1, 2))
               Set Dn = Dn.Offset(1, 2)
            Loop
    
        If nRng.Count > 1 Then
            Select Case nRng.Count
                Case 2: col = 3
                Case 3: col = 44
                Case Is >= 4: col = 23
            End Select
            nRng.Interior.ColorIndex = col
        End If
     End If
        Set nRng = Nothing
Next Dn
End sub

[p45cal]

…and a conditional formatting option (although in this implementation the grid needs to be clear of any numbers 6 columns either side, and 3 rows above and below it).

Who'd have thought there'd be so many offerings for such an oblique question?

[mdmackillop]

a conditional formatting option