Fill colours in 3 columns conditional subject

[motilulla]

Hello,

I want to be filled colour in columns E, F, G if in 3 consecutive rows find any values

Example1-F8, G9, E10 in 3 of the column and in 3 consecutive rows find some values fill colour in it.

Example2-E15, F16, G17 in 3 of the column and in 3 consecutive rows find some values fill colour in it.

Example3-G17, F18, E19 in 3 of the column and in 3 consecutive rows find some values fill colour in it.

Sample sheet attached

Book1
	D	E	F	G	H
1
2
3
4
5		n1	n2	n3
6
7
8			3
9				1
10		1
11
12			2
13
14
15		3
16			1
17				1
18			1
19		2
20
21		2
22				1
23		1
24			1
25		1
26				1
27
28			1
29
30		6
31				1
32			1
33				1
34		1
35
36
37			3
38		1
39			1
40				1
41
42			2
43
44		2
45				1
46		1
47				1
48
49
50
51			5
52				1
53			1
54		1
55			1
56
57		2
58				1
59			1
60				1
61
62
63		3
64
65			2
66		1
67
Sheet1

Thank you all
Excel 2000
Regards,
Moti

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG04Nov49
[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] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Rw = UsedRange.Rows.Count
[COLOR="Navy"]Set[/COLOR] Rng = Range("E6").Resize(Rw)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] n = 0 To 2
        [COLOR="Navy"]For[/COLOR] Ac = 0 To 2
            [COLOR="Navy"]If[/COLOR] Dn.Offset(n, Ac) <> "" [COLOR="Navy"]Then[/COLOR]
                 [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]Set[/COLOR] nRng = Dn.Offset(n, Ac)
                 [COLOR="Navy"]Else[/COLOR]
                    [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn.Offset(n, Ac))
                [COLOR="Navy"]End[/COLOR] If
              Col = Col + Dn.Offset(n, Ac).Column - 4
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] nRng.Count = 3 And Col = 6 [COLOR="Navy"]Then[/COLOR]
        nRng.Interior.Color = vbRed
    [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Set[/COLOR] nRng = Nothing: Col = 0
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[motilulla]

Try this:-
Regards Mick

MickG, Thank you for the macro. Please could you takes a look it is stopping at line "Rw = UsedRange.Rows.Count" giving an error message 424

Regards,
Moti

 

[MickG]

If your running from Macro dialog box, you will probably need:-

Rw = Activesheet.Usedrange.Rows.count

 

[motilulla]

If your running from Macro dialog box, you will probably need:-

Rw = Activesheet.Usedrange.Rows.count

MickG, much appreciated no errors working excellent!

Have a good weekend

Regards,
Moti

 

[MickG]

You're welcome