Highlights only last rows if character match

[motilulla]

Hello,

I am looking if someone can make VBA that can highlights last 3 rows in the column C:I if finds the sequence of "1X2" order does not matter must be all 3 character there
As per example below

Book1
	A	B	C	D	E	F	G	H	I	J
1
2
3
4
5
6
7	N	Year	n1	n2	n3	n4	n5	n6	n7
8	N	Year	n1	n2	n3	n4	n5	n6	n7
9	1	70/71	X	1	1	2	1	2	1
10	2	70/71	2	1	X	X	2	2	2
11	3	70/71	2	1	2	1	1	2	2
12	4	70/71	1	X	X	1	1	1	X
13	5	70/71	2	1	2	X	X	1	X
14	6	70/71	2	2	2	1	1	1	X
15	7	70/71	1	1	1	X	2	2	2
16	8	70/71	1	X	1	1	2	1	2
17	9	70/71	1	1	2	1	1	X	1
18	10	70/71	2	2	1	X	1	2	2
19	11	70/71	2	X	X	X	2	1	2
20	12	70/71	2	1	X	2	2	2	2
21	13	70/71	1	2	X	X	2	1	2
22	14	70/71	X	X	1	1	2	1	1
23	15	70/71	1	1	2	2	1	1	2
24	16	70/71	X	2	1	1	2	2	1
25	17	70/71	1	1	2	X	1	1	X
26	18	70/71	1	2	X	1	1	2	2
27	19	70/71	2	1	2	1	2	1	1
28	20	70/71	1	1	2	X	X	1	1
29	21	70/71	2	1	1	X	2	1	2
30	22	70/71	1	X	2	1	2	1	1
31	23	70/71	1	2	X	X	2	2	2
32	24	70/71	X	1	X	2	1	1	2
33	25	70/71	2	1	1	1	X	2	1
34	26	70/71	1	2	2	2	2	2	X
35
Sheet2

Thank you all
Excel 2000
Regards,
Moti

 

[Scott T]

Try

Sub hl1x2()

Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("C9:I" & lr).Interior.ColorIndex = xlNone

For x = 3 To 9
    If IsNumeric(Application.Match(1, Range(Cells(lr - 2, x), Cells(lr, x)), 0)) And IsNumeric(Application.Match("X", Range(Cells(lr - 2, x), Cells(lr, x)), 0)) And IsNumeric(Application.Match(2, Range(Cells(lr - 2, x), Cells(lr, x)), 0)) Then
        Range(Cells(lr - 2, x), Cells(lr, x)).Interior.ColorIndex = 8
    
    End If
Next x

End Sub

 

[BobUmlas]

Sub Highlight()
Set rg = Range("C9").CurrentRegion
l = rg.Rows.Count + rg.Row - 3
For cl = 3 To 9
If yes(l, cl) Then
Cells(l, cl).Resize(3).Interior.Color = vbGreen
GoTo Nx
End If
Nx:
Next
End Sub
Function yes(rw, col) As Boolean
tot = 0

For i = rw To rw + 2
Select Case Cells(i, col).Value
Case 1
tot = tot + 1
Case "x"
tot = tot + 2
Case 2
tot = tot + 4
End Select
Next
If tot = 7 Then yes = True
End Function

 

[motilulla]

Try

Sub hl1x2()

Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("C9:I" & lr).Interior.ColorIndex = xlNone

For x = 3 To 9
    If IsNumeric(Application.Match(1, Range(Cells(lr - 2, x), Cells(lr, x)), 0)) And IsNumeric(Application.Match("X", Range(Cells(lr - 2, x), Cells(lr, x)), 0)) And IsNumeric(Application.Match(2, Range(Cells(lr - 2, x), Cells(lr, x)), 0)) Then
        Range(Cells(lr - 2, x), Cells(lr, x)).Interior.ColorIndex = 8
    
    End If
Next x

End Sub

Thank you Scott T, it is running perfect as request.

Dim lr As Long, x As Long

Good luck!

Regards,
Moti

 

[sericom]

    sRow = Cells(Rows.Count, 1).End(xlUp).Row - 2
        For Each c In Range("C" & sRow & ":I" & sRow)
            If c <> c.Offset(1) And c <> c.Offset(2) And c.Offset(1) <> c.Offset(2) Then
                c.Resize(3).Interior.ColorIndex = 8
            End If
        Next

 

[motilulla]

Sub Highlight()
Set rg = Range("C9").CurrentRegion
l = rg.Rows.Count + rg.Row - 3
For cl = 3 To 9
If yes(l, cl) Then
Cells(l, cl).Resize(3).Interior.Color = vbGreen
GoTo Nx
End If
Nx:
Next
End Sub
Function yes(rw, col) As Boolean
tot = 0

For i = rw To rw + 2
Select Case Cells(i, col).Value
Case 1
tot = tot + 1
Case "x"
tot = tot + 2
Case 2
tot = tot + 4
End Select
Next
If tot = 7 Then yes = True
End Function

Thank you BobUmlas, I checked your code it is not highlighting any cells I always suspect it is because of version 2000.

Good luck!

Regards,
Moti

 

[motilulla]

    sRow = Cells(Rows.Count, 1).End(xlUp).Row - 2
        For Each c In Range("C" & sRow & ":I" & sRow)
            If c <> c.Offset(1) And c <> c.Offset(2) And c.Offset(1) <> c.Offset(2) Then
                c.Resize(3).Interior.ColorIndex = 8
            End If
        Next

Thank you sericom, it is running perfect.

Added following 3 Scott T lines

 Sub ABC()
Dim lr As Long, x As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("C9:I" & lr).Interior.ColorIndex = xlNone
 
sRow = Cells(Rows.Count, 1).End(xlUp).Row - 2
        For Each c In Range("C" & sRow & ":I" & sRow)
            If c <> c.Offset(1) And c <> c.Offset(2) And c.Offset(1) <> c.Offset(2) Then
                c.Resize(3).Interior.ColorIndex = 8
            End If
        Next
End Sub

Good luck!

Regards,
Moti

 

[sericom]

No need to work out the last row twice

Sub ABC()
    Dim lr As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Range("C9:I" & lr).Interior.ColorIndex = xlNone
    For Each c In Range("C" & lr - 2 & ":I" & lr - 2)
        If c <> c.Offset(1) And c <> c.Offset(2) And c.Offset(1) <> c.Offset(2) Then
            c.Resize(3).Interior.ColorIndex = 8
        End If
    Next
End Sub

 

[motilulla]

No need to work out the last row twice

Sub ABC()
    Dim lr As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Range("C9:I" & lr).Interior.ColorIndex = xlNone
    For Each c In Range("C" & lr - 2 & ":I" & lr - 2)
        If c <> c.Offset(1) And c <> c.Offset(2) And c.Offset(1) <> c.Offset(2) Then
            c.Resize(3).Interior.ColorIndex = 8
        End If
    Next
End Sub

Thank you sericom, this did the trick now it is perfect!

Good luck!

Regards,
Moti