Especial fill cells colouring as per predefined number of rows

[Kishan]

Using Excel 2000

Hi,

I need a code, which can fill colours in column C as per predefined numbers of row data are shown in the cells E6:E15

For example...
Count the cell down to C5, if C6 = 0 than fill 5 rows C6:C10 with red and white colour as data shown in cell E6 = 5.

Next fill 12 rows C11:C22 with green and white colour as data shown in cell E7 = 12.

Continue and fill 11 rows C23:C33 with blue and white colour as data shown in cell E8 = 11.

Repeat these 3 colours as shown below in the example data.

Data example...

Book1
	A	B	C	D	E	F
1
2
3
4					Fill
5			C1		Colours
6			X		5
7			X		12
8			X		11
9			2		4
10			1		5
11			X		5
12			X		7
13			1		6
14			1		3
15			1		14
16			X
17			1
18			1
19			X
20			1
21			1
22			2
23			1
24			X
25			1
26			X
27			1
28			1
29			1
30			1
31			1
32			1
33			2
34			1
35			2
36			1
37			X
38			X
39			X
40			1
41			X
42			2
43			X
44			X
45			1
46			1
47			2
48			1
49			X
50			X
51			X
52			X
53			X
54			2
55			X
56			1
57			X
58			1
59			1
60			2
61			X
62			2
63			1
64			1
65			1
66			X
67			X
68			1
69			X
70			1
71			1
72			1
73			1
74			1
75			1
76			1
77			2
78			1
79			1
80			1
81			2
82			2
83			X
84			1
85			X
86			1
87			1
88			1
89
Sheet1

Thank you in advance

Regards,
Kishan

 

[MickG]

I'm not sure about "C6" = 0 , but this code will colour column "C" based on column "E" Numbers.

[COLOR="Navy"]Sub[/COLOR] MG16Sep23
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] col [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("E6"), Range("E" & Rows.Count).End(xlUp))
col = Array(3, 10, 5)
c = 6
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]With[/COLOR] Cells(c, 3).Resize(Dn.Value)
        .Interior.ColorIndex = col(num)
        .Font.ColorIndex = 2
    [COLOR="Navy"]End[/COLOR] With
    c = c + Dn.Value
    num = num + 1
    num = IIf(num = 3, 0, num)
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

I'm not sure about "C6" = 0 , but this code will colour column "C" based on column "E" Numbers.

[COLOR=navy]Sub[/COLOR] MG16Sep23
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] col [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range(Range("E6"), Range("E" & Rows.Count).End(xlUp))
col = Array(3, 10, 5)
c = 6
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]With[/COLOR] Cells(c, 3).Resize(Dn.Value)
        .Interior.ColorIndex = col(num)
        .Font.ColorIndex = 2
    [COLOR=navy]End[/COLOR] With
    c = c + Dn.Value
    num = num + 1
    num = IIf(num = 3, 0, num)
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Awesome!! MickG, I don't know how you make the query possible it is working as requested very satisfactorily.

Thank you so much for your help

Kind Regards,
Kishan

 

[MickG]

You're welcome

 

[hiker95]

MickG,

I tried to send you a Private Message, but, your mailbox is full.

Can you provide a macro solution with upper and lower case information?

Reference reply #19 at the next link:

http://www.mrexcel.com/forum/excel-questions/840231-help.html

Thanks in advance.

hiker95

 

[MickG]

hiker95:-
Sorry about the "PM" box, I think its clear now.
Looking at the other post it appears you have now provided as solution, so I'll leave as is !!

 

[Kishan]

Hi MickG,

I need colour to filled as shown below skip "0" zeros

But same time I am asking a solution which has no logic because how the macro will mange numbers for value "0" is it 5, is it 4 is it 7 or it 3 I have thought a lot to make some helper column which can be applied to skip these "0" value but keep counting "0" zeros for next colouring cells

I leave it to you may you get some logical solution to get this solved if not I know my query is illogical please ignore it.

Book1
	A	B	C	D	E	F
1
2
3
4					Fill
5			C1		Colours
6			X		0
7			X		12
8			X		11
9			2		0
10			1		5
11			X		5
12			X		0
13			1		6
14			1		0
15			1		14
16			X
17			1
18			1
19			X
20			1
21			1
22			2
23			1
24			X
25			1
26			X
27			1
28			1
29			1
30			1
31			1
32			1
33			2
34			1
35			2
36			1
37			X
38			X
39			X
40			1
41			X
42			2
43			X
44			X
45			1
46			1
47			2
48			1
49			X
50			X
51			X
52			X
53			X
54			2
55			X
56			1
57			X
58			1
59			1
60			2
61			X
62			2
63			1
64			1
65			1
66			X
67			X
68			1
69			X
70			1
71			1
72			1
73			1
74			1
75			1
76			1
77			2
78			1
79			1
80			1
81			2
82			2
83			X
84			1
85			X
86			1
87			1
88			1
89
Sheet2

Thank you

Kind Regards,
Kishan

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG23Sep34
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n3 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Col [COLOR="Navy"]As[/COLOR] Variant, nCol [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
Rng.Interior.ColorIndex = xlNone
Rng.Font.ColorIndex = 1
Col = Array(3, 10, 5)
St = 6: c = 5: Dn = 6
[COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] c <= Rng.Count
    c = c + 1
    [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Cells(c, 3).Value
        [COLOR="Navy"]Case[/COLOR] 1: n1 = 1
        [COLOR="Navy"]Case[/COLOR] 2: n2 = 2
        [COLOR="Navy"]Case[/COLOR] "X": n3 = 3
    [COLOR="Navy"]End[/COLOR] Select
    [COLOR="Navy"]If[/COLOR] Application.Product(n1, n2, n3) > 0 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not Range("E" & Dn).Value = 0 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]With[/COLOR] Range("C" & St).Resize(c - (St - 1))
                .Interior.ColorIndex = Col(nCol)
                .Font.ColorIndex = 2
            [COLOR="Navy"]End[/COLOR] With
        [COLOR="Navy"]End[/COLOR] If
        nCol = IIf(nCol = 2, -1, nCol)
        nCol = nCol + 1
        St = c + 1
        n1 = 0: n2 = 0: n3 = 0
        Dn = Dn + 1
    [COLOR="Navy"]End[/COLOR] If
Loop
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

Try this:-

[COLOR=navy]Sub[/COLOR] MG23Sep34
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] n1 [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] n2 [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] n3 [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] St [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Col [COLOR=navy]As[/COLOR] Variant, nCol [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
Rng.Interior.ColorIndex = xlNone
Rng.Font.ColorIndex = 1
Col = Array(3, 10, 5)
St = 6: c = 5: Dn = 6
[COLOR=navy]Do[/COLOR] [COLOR=navy]While[/COLOR] c <= Rng.Count
    c = c + 1
    [COLOR=navy]Select[/COLOR] [COLOR=navy]Case[/COLOR] Cells(c, 3).Value
        [COLOR=navy]Case[/COLOR] 1: n1 = 1
        [COLOR=navy]Case[/COLOR] 2: n2 = 2
        [COLOR=navy]Case[/COLOR] "X": n3 = 3
    [COLOR=navy]End[/COLOR] Select
    [COLOR=navy]If[/COLOR] Application.Product(n1, n2, n3) > 0 [COLOR=navy]Then[/COLOR]
        [COLOR=navy]If[/COLOR] Not Range("E" & Dn).Value = 0 [COLOR=navy]Then[/COLOR]
            [COLOR=navy]With[/COLOR] Range("C" & St).Resize(c - (St - 1))
                .Interior.ColorIndex = Col(nCol)
                .Font.ColorIndex = 2
            [COLOR=navy]End[/COLOR] With
        [COLOR=navy]End[/COLOR] If
        nCol = IIf(nCol = 2, -1, nCol)
        nCol = nCol + 1
        St = c + 1
        n1 = 0: n2 = 0: n3 = 0
        Dn = Dn + 1
    [COLOR=navy]End[/COLOR] If
Loop
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Hats off to you MickG, I have no words to express your talent. It is unbelievable but done.

God Bless You

Thank you

Have a lovely weekend

Kind Regards,
Kishan

 

[MickG]

You're welcome