Particular highight of both rows and columns

Maybe :

Sub Test()
  Dim rng As Range, a, b, c As Long, i As Long, j As Long, k As Long, t As Boolean
  Set rng = Sheet1.Range("A1").CurrentRegion.Columns("P")
  a = rng.Resize(rng.Rows.Count + 1).Value
  ReDim b(1 To UBound(a, 1), 1 To 3)
  For i = 1 To UBound(a, 1)
      For j = i To UBound(a, 1)
          If a(j, 1) <> a(i, 1) Then
             t = Not t
             c = IIf(t, 1, 2)
             For k = i To j - 1
                 b(k, c) = 1
             Next k
             If j - i <> a(i, 1) Then
                For k = i To j - 1
                    b(k, 3) = 1
                Next k
             End If
             i = j - 1
             Exit For
          End If
      Next j
  Next i
  Application.ScreenUpdating = False
    With rng.Offset(, 7).Resize(, 3)
      .Value = b
      Intersect(.Columns(1).SpecialCells(xlCellTypeConstants).EntireRow, rng.CurrentRegion).Interior.Color = 16777215
      Intersect(.Columns(2).SpecialCells(xlCellTypeConstants).EntireRow, rng.CurrentRegion).Interior.Color = 13434879
      Intersect(.Columns(3).SpecialCells(xlCellTypeConstants).EntireRow, rng).Interior.Color = 16763904
      .ClearContents
    End With
  Application.ScreenUpdating = True
End Sub

Terry,

You said :

Originally Posted by terryhenderson

highlight, in a third colour, ColP cells for the data group which are not in the same number as shown in those cells. As per Sheet2 of the example, cells P4-P12 are highlighed in blue because the group is of 9 rows not 11. The same applied on cells P24-P39 because the group is of 16 rows not 17 as shown in ColP.

Now if I look at P13-P16 (they are 4 rows), the value of the cell is 2 (not 4), so by your requirement above, isn't this one also must be marked as blue ?

CMIIW

You are welcome Terry. In case there is/are consecutive same group of ColP, please try the code below, I don't know if this is actually you needed.

Sub Test2()
  Dim rng As Range, a, b, c As Long, i As Long, j As Long, k As Long, t As Boolean
  Set rng = Sheet1.Range("A1").CurrentRegion.Columns("P")
  a = rng.Resize(rng.Rows.Count + 1).Value
  ReDim b(1 To UBound(a, 1), 1 To 3)
  For i = 1 To UBound(a, 1) - 1
      t = Not t
      c = IIf(t, 1, 2)
      For j = i To Application.Min(i + a(i, 1) - 1, UBound(a, 1))
          If a(j, 1) = a(i, 1) Then
             b(j, c) = 1
          Else
             For k = i To j - 1
                 b(k, 3) = 1
             Next k
             Exit For
          End If
      Next j
      i = j - 1
  Next i
  Application.ScreenUpdating = False
    With rng.Offset(, 7).Resize(, 3)
      .Value = b
      Intersect(.Columns(1).SpecialCells(xlCellTypeConstants).EntireRow, rng.CurrentRegion).Interior.Color = 16777215
      Intersect(.Columns(2).SpecialCells(xlCellTypeConstants).EntireRow, rng.CurrentRegion).Interior.Color = 13434879
      Intersect(.Columns(3).SpecialCells(xlCellTypeConstants).EntireRow, rng).Interior.Color = 16763904
      .ClearContents
    End With
  Application.ScreenUpdating = True
End Sub

Regards

You are welcome, thanks for marking the thread as solved.

Regards

@ terryhenderson

Karedog provided you with an excellent solution, and I hope you have awarded him some Rep Points!

Regards.