VBA loop

tmagan

New Member
Joined
Aug 20, 2021
Messages
13
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hello Folks,
This is TAMIL, new to the forum and Excel VBA.
Speaking of which, I am working on a very small VBA program and ended up nowhere. So, I am looking for some experts help here.
I have a numbers in three cells under a title RED, Yellow and Green. Here I want cells next to this to change its color to RED, Yellow and green based on number on the reference cell.
i.e., If number under the title RED says 10, it should make 10 cells RED followed by the other colors.

How do I do this?
1629472757895.png
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
You will have to adjust the conditional formatting formulas to account for the columns to the left of your data. In my case that was three, but in yours it appears it will be many more.

Book2
ABCDEFGHIJKLMNOPQR
1RedYellowGree
2357
3
4
Sheet1
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D2:V2Expression=COLUMN(D2)<=$A$2+3textYES
D2:V2Expression=COLUMN(D2)<=$A$2+$B$2+3textYES
D2:V2Expression=COLUMN(D2)<=$A$2+$B$2+$C$2+3textNO
 
Upvote 0
Here is the update given your columns

Book2
ALAMANAOAPAQARASATAUAVAWAXAYAZBABBBC
1RedYellowGree
22310
340
4
5
Sheet1
Cell Formulas
RangeFormula
AN3AN3=COLUMN()
Cells with Conditional Formatting
CellConditionCell FormatStop If True
AO2:BG2Expression=COLUMN(AO2)<=$AL$2+40textYES
AO2:BG2Expression=COLUMN(AO2)<=$AL$2+$AM$2+40textYES
AO2:BG2Expression=COLUMN(AO2)<=$AL$2+$AM$2+$AN$2+40textNO
 
Upvote 0
Welcome to the MrExcel Message Board!

Assuming your data starts at row 3

VBA Code:
Sub ColorCell()
  Dim c As Range
  Range("AO3", Cells(Rows.Count, Columns.Count)).Interior.Color = xlNone
  For Each c In Range("AL3", Range("AL" & Rows.Count).End(3))
    Range("AO" & c.Row).Resize(, c).Interior.Color = vbRed
    Range("AO" & c.Row).Offset(, c).Resize(, c.Offset(, 1)).Interior.Color = vbYellow
    Range("AO" & c.Row).Offset(, c + c.Offset(, 1)).Resize(, c.Offset(, 2)).Interior.Color = vbGreen
  Next
End Sub
 
Upvote 0
Assumed data starts from 2 nd row. AL2=10, AL3=9, AL4=9, AL5=3.. etc

VBA Code:
Sub ColorCells()
Dim LR, T, k1, k2, k3 As Long

LR = Range("AL" & Rows.Count).End(xlUp).Row
For T = 2 To LR
k1 = Range("AL" & T)
k2 = Range("AM" & T)
k3 = Range("AN" & T)
Range(Cells(T, "AO"), Cells(T, "AO").Offset(0, k1 - 1)).Interior.ColorIndex = 3
Range(Cells(T, "AO").Offset(0, k1), Cells(T, "AO").Offset(0, k1 + k2 - 1)).Interior.ColorIndex = 6
Range(Cells(T, "AO").Offset(0, k1 + k2), Cells(T, "AO").Offset(0, k1 + k2 + k3 - 1)).Interior.ColorIndex = 4
Next T

End Sub
 
Upvote 0
Assumed data starts from 2 nd row. AL2=10, AL3=9, AL4=9, AL5=3.. etc

VBA Code:
Sub ColorCells()
Dim LR, T, k1, k2, k3 As Long

LR = Range("AL" & Rows.Count).End(xlUp).Row
For T = 2 To LR
k1 = Range("AL" & T)
k2 = Range("AM" & T)
k3 = Range("AN" & T)
Range(Cells(T, "AO"), Cells(T, "AO").Offset(0, k1 - 1)).Interior.ColorIndex = 3
Range(Cells(T, "AO").Offset(0, k1), Cells(T, "AO").Offset(0, k1 + k2 - 1)).Interior.ColorIndex = 6
Range(Cells(T, "AO").Offset(0, k1 + k2), Cells(T, "AO").Offset(0, k1 + k2 + k3 - 1)).Interior.ColorIndex = 4
Next T

End Sub
Hi,
Thank you so much for your response.
I have tried your code, it shows following error.
Also, just an FYI, the ROW is 6 in my case.
1629477511710.png

Followed by this Error once it gets updated with some different number. (the RED, Yellow and green mismatches)

1629477604143.png
 
Upvote 0
Why do you need to use VBA for this? Conditional formatting handles this quite nicely.
 
Upvote 0
Welcome to the MrExcel Message Board!

Assuming your data starts at row 3

VBA Code:
Sub ColorCell()
  Dim c As Range
  Range("AO3", Cells(Rows.Count, Columns.Count)).Interior.Color = xlNone
  For Each c In Range("AL3", Range("AL" & Rows.Count).End(3))
    Range("AO" & c.Row).Resize(, c).Interior.Color = vbRed
    Range("AO" & c.Row).Offset(, c).Resize(, c.Offset(, 1)).Interior.Color = vbYellow
    Range("AO" & c.Row).Offset(, c + c.Offset(, 1)).Resize(, c.Offset(, 2)).Interior.Color = vbGreen
  Next
End Sub
HI Dante,
Thank you for your response.
My data starts from the ROW 6. Followed by, I see this error when I run the code.
1629478058778.png


Also, if I change the number to less than 10, the whole format changes as shown below, it is not going past 4 rows.
1629478179441.png
 
Upvote 0
Here is the update given your columns

Book2
ALAMANAOAPAQARASATAUAVAWAXAYAZBABBBC
1RedYellowGree
22310
340
4
5
Sheet1
Cell Formulas
RangeFormula
AN3AN3=COLUMN()
Cells with Conditional Formatting
CellConditionCell FormatStop If True
AO2:BG2Expression=COLUMN(AO2)<=$AL$2+40textYES
AO2:BG2Expression=COLUMN(AO2)<=$AL$2+$AM$2+40textYES
AO2:BG2Expression=COLUMN(AO2)<=$AL$2+$AM$2+$AN$2+40textNO
Hi mate,
I am trying the condition formatting, I didn't get your whole formatting window.
I will have to check once again.
 
Upvote 0
Book2
ALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBY
1RedYellowGree
21052
3992
4992
5342
6012
7123
8234
9345
10456
11567
12678
13789
148910
15
Sheet1
Cells with Conditional Formatting
CellConditionCell FormatStop If True
AO2:BY29Expression=COLUMN(AO2)<=$AL2+40textYES
AO2:BY29Expression=COLUMN(AO2)<=$AL2+$AM2+40textYES
AO2:BY29Expression=COLUMN(AO2)<=$AL2+$AM2+$AN2+40textNO
 
Upvote 0

Forum statistics

Threads
1,213,528
Messages
6,114,154
Members
448,553
Latest member
slaytonpa

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