Conditional formatting

I need your help in this work, and hope you have a solution by the formula

I think this is the solution
=or(countif(list1;a1)>0;countif(list2;a1)>1;counti f(list3;a1)>1;countif(list4;a1)>1;countif(list5;a1 )>1)
and other formatt
=or(countif(list1;a1)>1;countif(list2;a1)>0;counti f(list3;a1)>0;countif(list4;a1)>0;countif(list5;a1 )>0)

Can you please explain the logic first. I see a few cells colored when they break the numbering sequence. But I also see some inconsistencies in the ordering of the green cells also. Can you please clarify that?

This table I think more clarification

Not clearly mentioned in the file only found some colored cells and don't understand by which criteria. :confused:

Hi,

Try this macro.

Code:

---

Option Explicit

Sub kTest()
   
    Dim d, r As Long, c As Long, n As Long, Rng As Range
    Dim dic As Object, a() As String, x, y, Colors, j As Long
   
    Set Rng = Range("a1:j12")                  '<<< adjust the range
    d = Rng.Value2
   
    Colors = Array(255, 65535, 52479, 8388736)  '<<< add as many as interior colors
   
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    x = Application.Index(d, 0, 1)
    n = -1
    For r = 1 To UBound(d, 1)
        For c = 3 To UBound(d, 2) Step 2
            If Len(d(r, c)) Then
                y = Application.Match(d(r, c), x, 0)
                If IsError(y) Then
                    If Not dic.exists(d(r, c)) Then
                        n = n + 1: dic.Item(d(r, c)) = Colors(n)
                        j = j + 1: ReDim Preserve a(1 To j)
                        a(j) = Rng.Cells(r, c + 1).Address & "|" & Colors(n)
                    Else
                        j = j + 1: ReDim Preserve a(1 To j)
                        a(j) = Rng.Cells(r, c + 1).Address & "|" & dic.Item(d(r, c))
                    End If
                End If
            End If
        Next
    Next
   
    x = Array(dic.keys, dic.items)
   
    With Rng
        For r = 0 To UBound(x(0))
            Application.ReplaceFormat.Interior.Color = x(1)(r)
            .Replace What:=x(0)(r), Replacement:=x(0)(r), LookAt:=xlWhole, ReplaceFormat:=True
        Next
        For r = 1 To j
            y = Split(a(r), "|")
            .Range(y(0)).Interior.Color = y(1)
        Next
    End With

End Sub

---

Quote:

---

Originally Posted by Admin

Dim d, r As Long, c As Long, n As Long, Rng As Range
Dim dic As Object, a() As String, x, y, Colors, j As Long
[/code]

---

Admin... I think you forgot for the moment you were writing VBA code... the d, x, y and Colors variable will all be declared as Variants for the above Dim statements. For those reading this message... in VBA, each variable must be individually declared as to its data type, otherwise it will be declared as a Variant. So, Admin meant to write the above like this...

Code:

---

Dim d As Long, r As Long, c As Long, n As Long, Rng As Range
Dim dic As Object, a() As String, x As Long, y As Long, Colors As Long, j As Long

---

Rick, I wouldn't be sure :), except for j maybe

Code:

---

Set Rng = Range("a1:j12")                  '<<< adjust the range
    d = Rng.Value2
Colors = Array(255, 65535, 52479, 8388736)
x = Application.Index(d, 0, 1)
x = Array(dic.keys, dic.items)
y = Split(a(r), "|")


---

Quote:

---

Originally Posted by Rick Rothstein

Admin... I think you forgot for the moment you were writing VBA code... the d, x, y and Colors variable will all be declared as Variants for the above Dim statements. For those reading this message... in VBA, each variable must be individually declared as to its data type, otherwise it will be declared as a Variant. So, Admin meant to write the above like this...

Code:

---

Dim d As Long, r As Long, c As Long, n As Long, Rng As Range
Dim dic As Object, a() As String, x As Long, y As Long, Colors As Long, j As Long

---

---

That's all (d, x, y and Colors ) meant to be as Variant.

and j is declared as long :)

wonderful but you can do it by formula