Especial fill cells colouring as per predefined number of rows

K

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
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
ABCDEF
1
2
3
4Fill
5C1Colours
6X5
7X12
8X11
924
1015
11X5
12X7
1316
1413
15114
16X
171
181
19X
201
211
222
231
24X
251
26X
271
281
291
301
311
321
332
341
352
361
37X
38X
39X
401
41X
422
43X
44X
451
461
472
481
49X
50X
51X
52X
53X
542
55X
561
57X
581
591
602
61X
622
631
641
651
66X
67X
681
69X
701
711
721
731
741
751
761
772
781
791
801
812
822
83X
841
85X
861
871
881
89
Sheet1


Thank you in advance

Regards,
Kishan
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
I'm not sure about "C6" = 0 , but this code will colour column "C" based on column "E" Numbers.
Code: 
[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
 
Upvote 0
MickG said:
I'm not sure about "C6" = 0 , but this code will colour column "C" based on column "E" Numbers.
Code: 
[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
Click to expand...
Awesome!! MickG, I don't know how you make the query possible it is working as requested very satisfactorily. :cool:

Thank you so much for your help

Kind Regards,
Kishan :)
 
Upvote 0
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 !!
 
Upvote 0
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
ABCDEF
1
2
3
4Fill
5C1Colours
6X0
7X12
8X11
920
1015
11X5
12X0
1316
1410
15114
16X
171
181
19X
201
211
222
231
24X
251
26X
271
281
291
301
311
321
332
341
352
361
37X
38X
39X
401
41X
422
43X
44X
451
461
472
481
49X
50X
51X
52X
53X
542
55X
561
57X
581
591
602
61X
622
631
641
651
66X
67X
681
69X
701
711
721
731
741
751
761
772
781
791
801
812
822
83X
841
85X
861
871
881
89
Sheet2


Thank you

Kind Regards,
Kishan

 
Upvote 0
Try this:-
Code: 
[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
 
Upvote 0
MickG said:
Try this:-
Code: 
[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
Click to expand...
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
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Search a range for a specific color of rows, relocate those cells to another sheet, return previous sheet formatting to blank and sort secondary sheet
Replies
4
Views
352
Royalbloodi
R
M
  • Solved
Fill random 3 columns.
Replies
5
Views
305
motilulla
M
J
  • Question Question
IF OR Formula change
Replies
5
Views
285
StephenCrump
S
F
  • Solved
How to count the nth set of 6 numbers (repeated 6 numbers based on another column)
Replies
2
Views
170
feni1388
F
D
  • Solved
VBA Filter code not working with blank variable criteria
Replies
7
Views
657
kevin9999
K

Forum statistics

Threads
1,223,704
Messages
6,173,984
Members
452,540
Latest member
haasro02

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top