Highlight only last ones that finds in end of the column

[Kishan]

Using Excel 2000
Hi,

In the cells C3:K3 got 9 patterns with 3 different colour groups I need a VBA which Highlights only 9 patterns finds last in the column C as shown in the example with same format as C3:K3

Example....

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2
3			1|1	1|X	1|2	X|1	X|X	X|2	2|1	2|X	2|2
4
5
6			1 | 2
7			2 | 2
8			X | 1
9			2 | 1
10			2 | 1
11			1 | 2
12			2 | 1
13			X | X
14			2 | 1
15			1 | 1
16			1 | 2
17			1 | 1
18			X | X
19			1 | 1
20			X | 1
21			1 | X
22			X | 2
23			2 | X
24			1 | 1
25			X | 2
26			2 | 2
27			X | X
28			2 | 1
29			1 | 2
30			1 | X
31			X | 2
32			1 | 2
33			X | 1
34			2 | X
35			X | 1
36			X | X
37			2 | 2
38
39
40
41
Sheet10

Thank you in advance

Regards,
Kishan

 

[Fluff]

How about

Sub Kishan()
   Dim i As Long
   
   With CreateObject("scripting.dictionary")
      For i = 3 To 11
         .Item(Cells(3, i).Value) = Cells(3, i).Interior.Color
      Next i
      For i = Range("C" & Rows.Count).End(xlUp).Row To 6 Step -1
         If .exists(Cells(i, 3).Value) Then
            Cells(i, 3).Interior.Color = .Item(Cells(i, 3).Value)
            .Remove Cells(i, 3).Value
         End If
      Next i
   End With
End Sub

The values in C3:K3 of your example don't include spaces, but those in C6:C37 do. They need to be the same for this to work.

 

[Peter_SSs]

Another way with the same comment as Fluff about spaces v No spaces.
I also assume that it is a mistake that you have cell C33 coloured and not C35?

Sub Highlight_Last()
  Dim c As Range, cFound As Range
  
  For Each c In Range("C3:K3")
    Set cFound = Range("C6:C37").Find(What:=c.Value, SearchDirection:=xlPrevious)
    If Not cFound Is Nothing Then cFound.Interior.Color = c.Interior.Color
  Next c
End Sub

 

[Kishan]

How about

Sub Kishan()

The values in C3:K3 of your example don't include spaces, but those in C6:C37 do. They need to be the same for this to work.

Hi, </SPAN></SPAN>Fluff, it is my fault I included the space in the header values in C3:K3 and code worked fine thank you so much for the help.</SPAN></SPAN>

Please can white font be added in it?</SPAN>

Kind Regards</SPAN></SPAN>
Kishan

Another way with the same comment as Fluff about spaces v No spaces.
I also assume that it is a mistake that you have cell C33 coloured and not C35?

Sub Highlight_Last()

Hi, </SPAN></SPAN>Peter_SSs, yes added a space in values C3:K3 code worked fine thank you for your help and observing yes I had a mistake C35 is correct to be coloured not C33 you are correct.</SPAN></SPAN>

Please can white font be added in it?</SPAN>

Kind Regards</SPAN></SPAN>
Kishan

</SPAN></SPAN></SPAN>

 

[Fluff]

How about

Sub Kishan()
   Dim i As Long
   
   With CreateObject("scripting.dictionary")
      For i = 3 To 11
         .Item(Cells(3, i).Value) = Cells(3, i).Interior.Color
      Next i
      For i = Range("C" & Rows.Count).End(xlUp).Row To 6 Step -1
         If .exists(Cells(i, 3).Value) Then
            Cells(i, 3).Interior.Color = .Item(Cells(i, 3).Value)
            Cells(i, 3).Font.Color = vbWhite
            .Remove Cells(i, 3).Value
         End If
      Next i
   End With
End Sub

 

[Kishan]

How about

Sub Kishan()
   Dim i As Long
   
   With CreateObject("scripting.dictionary")
      For i = 3 To 11
         .Item(Cells(3, i).Value) = Cells(3, i).Interior.Color
      Next i
      For i = Range("C" & Rows.Count).End(xlUp).Row To 6 Step -1
         If .exists(Cells(i, 3).Value) Then
            Cells(i, 3).Interior.Color = .Item(Cells(i, 3).Value)
            Cells(i, 3).Font.Color = vbWhite
            .Remove Cells(i, 3).Value
         End If
      Next i
   End With
End Sub

Fluff, that is great of you including quick a white font too it is just ideal. </SPAN></SPAN>
Thank you. </SPAN></SPAN>

Kind Regards</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Fluff]

You're welcome & thanks for the feedback

 

[Kishan]

Hi, </SPAN></SPAN>Peter_SSs, yes added a space in values C3:K3 code worked fine thank you for your help and observing yes I had a mistake C35 is correct to be coloured not C33 you are correct.</SPAN></SPAN>

Please can white font be added in it?</SPAN>

Kind Regards</SPAN></SPAN>
Kishan

</SPAN></SPAN></SPAN>

Peter_SSs, I tried and it could be able to modified to add the white font it were easy to add in your code. And I hope it is done correctly.</SPAN></SPAN>

Sub Highlight_Last()
  Dim c As Range, cFound As Range
  
     Dim lngLastRow As Long
     lngLastRow = Cells(Rows.Count, "C").End(xlUp).Row
       
  For Each c In Range("C3:K3")
    Set cFound = Range("C6:C" & lngLastRow).Find(What:=c.Value, SearchDirection:=xlPrevious)
    If Not cFound Is Nothing Then cFound.Interior.Color = c.Interior.Color
    If Not cFound Is Nothing Then cFound.Font.Color = c.Font.Color
  Next c
End Sub

Kind Regards</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Fluff]

You can simplify that slightly like

  For Each c In Range("C3:K3")
    Set cFound = Range("C6:C" & lngLastRow).Find(What:=c.Value, SearchDirection:=xlPrevious)
    If Not cFound Is Nothing Then
       cFound.Interior.Color = c.Interior.Color
       cFound.Font.Color = c.Font.Color
    End If
  Next c

 

[Kishan]

You can simplify that slightly like

  For Each c In Range("C3:K3")
    Set cFound = Range("C6:C" & lngLastRow).Find(What:=c.Value, SearchDirection:=xlPrevious)
    If Not cFound Is Nothing Then
       cFound.Interior.Color = c.Interior.Color
       cFound.Font.Color = c.Font.Color
    End If
  Next c

Fluff, that looks much better it worked fine thank you for making it simpler.</SPAN></SPAN>

Kind Regards</SPAN></SPAN>
Kishan </SPAN></SPAN>