Highlight 3 diagonals

[Kishan]

Using Excel 2000

Hi,

I need to highlights 3 diagonals weather are they numbers or alphabets

In the example below check first column C to find diagonal in the column D & E

For example C6 is empty go for C7 if C7 is empty go for C8, Yes find diagonal in C8, D9 & in E10 (in this case as in the row 8 find Diagonal check the complete row C8:P8 and highlight all diagonal) as found one more in the row 8 in cells M8, N10 & in O10 and continue same method to find all possible diagonal

Example data with numbers...

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1
2
3
4
5		ROW N	C1	C2	C3	C4	C5	C6	C7	C8	C9	C10	C11	C12	C13	C14
6		6					5		5	5
7		7					5	5				5	5
8		8	5	5	5	5			5			5	5		5
9		9		5	5	5			5				5	5	5	5
10		10			5			5		5	5	5	5		5
11		11	5				5			5	5
12		12	5	5		5	5				5
13		13	5		5	5				5	5	5	5	5
14		14			5	5					5		5
15		15		5		5	5		5			5		5	5	5
16		16	5	5		5	5				5	5		5	5
17		17		5			5			5					5
18		18		5	5	5					5					5
19		19	5		5		5		5	5	5	5		5		5
20		20			5			5		5		5			5	5
21		21	5	5	5				5	5	5	5		5	5
22		22	5	5		5		5		5		5			5
23		23	5	5	5				5		5				5	5
24		24		5	5	5	5	5	5	5	5	5		5		5
25		25		5	5				5	5		5
26		26		5				5				5	5	5		5
27		27	5		5	5		5							5
28		28	5	5	5			5	5		5	5		5		5
29		29		5				5	5	5	5	5	5		5
30		30				5	5		5	5			5
31		31	5	5	5			5			5		5			5
32		32			5			5	5	5
33		33				5	5				5	5	5
34		34	5				5			5	5		5	5	5
35		35	5		5			5	5			5		5	5	5
36		36	5		5		5	5		5		5		5	5
37		37				5	5	5	5	5	5	5	5	5	5
38		38	5	5		5			5	5			5	5	5
39		39	5	5	5	5				5						5
40		40		5			5	5		5						5
41		41	5	5	5	5				5		5		5		5
42		42	5						5		5		5	5		5
43		43		5		5	5	5	5		5	5		5
44		44	5	5			5	5	5	5	5		5	5		5
45		45		5					5		5					5
46		46	5	5	5			5			5	5		5
47		47	5		5		5	5	5		5	5	5	5		5
48		48	5		5		5	5			5			5
49		49		5	5	5		5					5
50		50			5	5			5		5	5
51		51		5	5		5	5	5	5		5		5	5	5
52		52					5		5				5			5
53		53	5	5		5		5	5		5	5	5			5
54		54		5			5	5				5		5	5	5
55		55					5	5					5	5	5
56		56	5	5						5	5	5	5	5		5
57		57		5	5			5	5			5		5	5
58		58		5	5			5					5	5		5
59		59	5			5				5		5
60		60				5		5		5	5	5	5	5
61		61	5					5		5		5
62		62	5	5		5	5		5	5	5	5	5	5		5
63		63		5	5					5			5	5	5
64		64		5	5	5		5			5		5
65		65	5		5					5	5	5	5	5	5
66		66						5	5	5	5		5	5	5
67		67		5	5		5		5	5			5		5
68		68		5								5			5
69		69		5		5	5				5				5
70		70	5			5	5	5				5				5
71		71		5				5		5	5	5
72		72				5	5	5		5	5	5
73		73	5	5	5					5	5					5
74		74	5		5	5		5		5				5
75		75	5	5		5	5		5				5	5	5
76		76			5		5			5		5		5		5
77		77						5				5
78		78		5						5			5
79		79
80		80
Sheet1

Example data with alphabets...

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1
2
3
4
5		ROW N	C1	C2	C3	C4	C5	C6	C7	C8	C9	C10	C11	C12	C13	C14
6		6					A		A	A
7		7					A	A				A	A
8		8	A	A	A	A			A			A	A		A
9		9		A	A	A			A				A	A	A	A
10		10			A			A		A	A	A	A		A
11		11	A				A			A	A
12		12	A	A		A	A				A
13		13	A		A	A				A	A	A	A	A
14		14			A	A					A		A
15		15		A		A	A		A			A		A	A	A
16		16	A	A		A	A				A	A		A	A
17		17		A			A			A					A
18		18		A	A	A					A					A
19		19	A		A		A		A	A	A	A		A		A
20		20			A			A		A		A			A	A
21		21	A	A	A				A	A	A	A		A	A
22		22	A	A		A		A		A		A			A
23		23	A	A	A				A		A				A	A
24		24		A	A	A	A	A	A	A	A	A		A		A
25		25		A	A				A	A		A
26		26		A				A				A	A	A		A
27		27	A		A	A		A							A
28		28	A	A	A			A	A		A	A		A		A
29		29		A				A	A	A	A	A	A		A
30		30				A	A		A	A			A
31		31	A	A	A			A			A		A			A
32		32			A			A	A	A
33		33				A	A				A	A	A
34		34	A				A			A	A		A	A	A
35		35	A		A			A	A			A		A	A	A
36		36	A		A		A	A		A		A		A	A
37		37				A	A	A	A	A	A	A	A	A	A
38		38	A	A		A			A	A			A	A	A
39		39	A	A	A	A				A						A
40		40		A			A	A		A						A
41		41	A	A	A	A				A		A		A		A
42		42	A						A		A		A	A		A
43		43		A		A	A	A	A		A	A		A
44		44	A	A			A	A	A	A	A		A	A		A
45		45		A					A		A					A
46		46	A	A	A			A			A	A		A
47		47	A		A		A	A	A		A	A	A	A		A
48		48	A		A		A	A			A			A
49		49		A	A	A		A					A
50		50			A	A			A		A	A
51		51		A	A		A	A	A	A		A		A	A	A
52		52					A		A				A			A
53		53	A	A		A		A	A		A	A	A			A
54		54		A			A	A				A		A	A	A
55		55					A	A					A	A	A
56		56	A	A						A	A	A	A	A		A
57		57		A	A			A	A			A		A	A
58		58		A	A			A					A	A		A
59		59	A			A				A		A
60		60				A		A		A	A	A	A	A
61		61	A					A		A		A
62		62	A	A		A	A		A	A	A	A	A	A		A
63		63		A	A					A			A	A	A
64		64		A	A	A		A			A		A
65		65	A		A					A	A	A	A	A	A
66		66						A	A	A	A		A	A	A
67		67		A	A		A		A	A			A		A
68		68		A								A			A
69		69		A		A	A				A				A
70		70	A			A	A	A				A				A
71		71		A				A		A	A	A
72		72				A	A	A		A	A	A
73		73	A	A	A					A	A					A
74		74	A		A	A		A		A				A
75		75	A	A		A	A		A				A	A	A
76		76			A		A			A		A		A		A
77		77						A				A
78		78		A						A			A
79		79
80		80
Sheet2

Thank you in advance

Kishan

 

[steve the fish]

Doesnt look like i understand the rules. Why isnt G6, H7, I8 highlighted? There are lots more examples of 3 in a diagonal i can see.

 

[Kishan]

Doesnt look like i understand the rules. Why isnt G6, H7, I8 highlighted? There are lots more examples of 3 in a diagonal i can see.

Hi steve the fish,

Your question has logic but rules are if in the column C do not find any diagonal so do not check further diagonal in that row

What I mean C6 is empty so we do not have diagonal in C6, D7, and E8 so forget the row 6 do not track diagonals in the row 6.

Same situation is C7 is empty we do not have diagonal in C7, D8, and E9 so forget the row 7 do not track diagonals in the row 7.

Yes in C8 we have diagonal in C8, D9, and E10 so find further diagonal in the row 8 also find As shown M8, N9, O10

Hope I have explained it.

Thank you

Kishan

 

[MickG]

Perhaps:-

[COLOR="Navy"]Sub[/COLOR] MG08Sep08
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Tdn [COLOR="Navy"]As[/COLOR] Range, nDn [COLOR="Navy"]As[/COLOR] Range, fd [COLOR="Navy"]As[/COLOR] Boolean
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    fd = False
    [COLOR="Navy"]For[/COLOR] Ac = 0 To 11
        [COLOR="Navy"]Set[/COLOR] nDn = Union(Dn.Offset(, Ac), Dn.Offset(1, Ac + 1), Dn.Offset(2, Ac + 2))
        [COLOR="Navy"]Set[/COLOR] Tdn = Union(Dn, Dn.Offset(1, 1), Dn.Offset(2, 2))
        [COLOR="Navy"]If[/COLOR] Application.CountA(Tdn) = 3 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Application.CountA(nDn) = 3 [COLOR="Navy"]Then[/COLOR]
                nDn.Interior.Color = IIf(Dn.Offset(1, Ac).Interior.Color = vbGreen, vbYellow, vbGreen)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[B___P]

Hi Kishan, not sure it is bullet proof but give this code a try:

Sub findDiagonals()
    Dim myrange As Range
    Dim mycell As Range
    Dim lastrow As Long
    Dim lastcol As Long
    Dim x As Long
    Dim y As Long
    lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 2
    lastcol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column - 2
    Set myrange = Range("c6:n" & lastrow)
    For x = 6 To lastrow
        For y = 3 To lastcol
            If y = 3 And (Cells(x, y).Value = "" Or Cells(x, y).Offset(1, 1).Value <> Cells(x, y).Value Or Cells(x, y).Offset(2, 2).Value <> Cells(x, y).Value) Then
                Exit For
            End If
            If Cells(x, y).Value <> "" [COLOR=#ff0000]And Cells(x, y).Interior.ColorIndex = -4142[/COLOR] And Cells(x, y).Offset(1, 1).Value = Cells(x, y).Value And Cells(x, y).Offset(2, 2).Value = Cells(x, y).Value Then
                If Cells(x, y).Row Mod 2 = 0 Then
                    Cells(x, y).Interior.ColorIndex = 6
                    Cells(x, y).Offset(1, 1).Interior.ColorIndex = 6
                    Cells(x, y).Offset(2, 2).Interior.ColorIndex = 6
                Else
                    Cells(x, y).Interior.ColorIndex = 33
                    Cells(x, y).Offset(1, 1).Interior.ColorIndex = 33
                    Cells(x, y).Offset(2, 2).Interior.ColorIndex = 33
                End If
            End If
        Next y
    Next x
End Sub

If you have issues with diagonals of 4 signs try to remove this part

And Cells(x, y).Interior.ColorIndex = -4142

Have a nice time

 

[Eric W]

You can do this with Conditional Formatting, although you'll just get one color, not yellow and blue.

In Q6, enter this formula:

=AND(C6<>"",C6=D7,D7=E8)
and drag down to Q80.

Now select the range C6:N78, click Conditional Formatting > New Rule > Use a formula, and enter this formula:
=AND($Q6,C6<>"",C6=D7,D7=E8)

choose a fill color and click OK.

Now select the range D7:O79, and repeat that process with the same formula. Select the range E8:P80 and repeat one last time. You should be good to go.

 

[Kishan]

Perhaps
Regards Mick

Hi Mick, the code is colouring alternate column in 2 different colours yellow & lime but do not highlighting the diagonals.

Please could you check?

Thank you

Kishan

 

[Kishan]

Hi Kishan, not sure it is bullet proof but give this code a try:

Sub findDiagonals()
    Dim myrange As Range
    Dim mycell As Range
    Dim lastrow As Long
    Dim lastcol As Long
    Dim x As Long
    Dim y As Long
    lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 2
    lastcol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column - 2
    Set myrange = Range("c6:n" & lastrow)
    For x = 6 To lastrow
        For y = 3 To lastcol
            If y = 3 And (Cells(x, y).Value = "" Or Cells(x, y).Offset(1, 1).Value <> Cells(x, y).Value Or Cells(x, y).Offset(2, 2).Value <> Cells(x, y).Value) Then
                Exit For
            End If
            If Cells(x, y).Value <> "" [COLOR=#ff0000]And Cells(x, y).Interior.ColorIndex = -4142[/COLOR] And Cells(x, y).Offset(1, 1).Value = Cells(x, y).Value And Cells(x, y).Offset(2, 2).Value = Cells(x, y).Value Then
                If Cells(x, y).Row Mod 2 = 0 Then
                    Cells(x, y).Interior.ColorIndex = 6
                    Cells(x, y).Offset(1, 1).Interior.ColorIndex = 6
                    Cells(x, y).Offset(2, 2).Interior.ColorIndex = 6
                Else
                    Cells(x, y).Interior.ColorIndex = 33
                    Cells(x, y).Offset(1, 1).Interior.ColorIndex = 33
                    Cells(x, y).Offset(2, 2).Interior.ColorIndex = 33
                End If
            End If
        Next y
    Next x
End Sub

If you have issues with diagonals of 4 signs try to remove this part

And Cells(x, y).Interior.ColorIndex = -4142

Have a nice time

Hi B___P, The first code is working perfect as per request does not need to remove part of the line.

Thank you so much for you help

Regards,
Kishan

 

[Kishan]

You can do this with Conditional Formatting, although you'll just get one color, not yellow and blue.

In Q6, enter this formula:

=AND(C6<>"",C6=D7,D7=E8)
and drag down to Q80.

Now select the range C6:N78, click Conditional Formatting > New Rule > Use a formula, and enter this formula:
=AND($Q6,C6<>"",C6=D7,D7=E8)

choose a fill color and click OK.

Now select the range D7:O79, and repeat that process with the same formula. Select the range E8:P80 and repeat one last time. You should be good to go.

Hi Eric W, I tried your Conditional Formatting formula and it is perfect.

Thank you so much for you help

Regards,
Kishan

 

[Eric W]

Glad we could help.