Excel VBA Conditional Format Column/Row Offset Based Upon Cell Condition

jhedges

Board Regular
Joined
May 27, 2009
Messages
208
I have an Excel spreadsheet, which is setup like a calendar. I can change the year at the top and the corresponding dates change in the days of the week columns. So, Monday thru Saturday are showing from E5:T5 and all the remaining rows are below. So, Monday is Merged in E5:G5, blank cells in E6,F6,G6, Date merged in E7:G7, two information merged cells in E8:G8 and E9:G9 and then individual cells in E10,F10,G10 thru E13,F13,G13. Tuesday is then in HIJ, Wednesday in KLM thru Friday in QRS and Saturday is then in T...Sunday is hidden in BCD. Then the pattern repeats for the entire year from row 6. The days of the week stay in row 5. What I would like is if the first six letters = "Closed" in the merged cells of row 9, 17, 25, 33, 41, 49, 57, 65, 73, 81, 89 up to 577 going up by 8, then the three columns and four rows below would be formatted in the light green color. So, if E9:G9 = "CLOSED MLK", then Cells E10,F10,G10 thru E13,F13,G13 would conditionally format to the light green color. This would repeat for each day of the week and all the way thru the end of the calendar in row 581. I can post an example if that helps? Just trying to keep from doing individual conditional formats as I change the year of the calendar...Any help would be appreciated...
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

I have posted an example below. What I would like to do via VBA is to look for the word "closed" in INFO row and color in the cells in the 3 columns and 4 rows below the cell with the word "closed" with light green. If the day is Saturday and "closed" is in the INFO row, then the cell in the 4th row below is colored light green.

The 9th row repeats again in rows 17, 25, 33, 41, 49, 57, 65, 73, 81, 89 up to 577 going up by 8

Master Schedule

*AEFGHIJKLMNOPQRST
52017MONDAYTUESDAYWEDNESDAYTHURSDAYFRIDAYSAT
6January****************
7DATE:Jan-02Jan-03Jan-04Jan-05Jan-06Jan-07
8VAC:******
9INFO:CLOSED**AH New Real. 8:30am**
10GO***NTRPMKKKNT/AHMKMKPSNTRPNTMK*
11F&HCIC***AH*PSRP*PSRP*AHPS*AH*
12MBC***CDJHSASCD*SASSASCDEG3-8JHSASCD*
13WHBC***BM*JKEG5-10JK/JHBMJKJHBMJKBMEG2-7NT
14*New Pay Period/Kronos********Payday******
15DATE:Jan-09Jan-10Jan-11Jan-12Jan-13Jan-14
16VAC:******
17INFO:*****CLOSED
18GOKKRP/MKNTNTRPMKKKNT/AHMKMKPSNTMKRPNT*
19F&HCICPS*AHAH*PSRP*PSRP*AHAH*PS*
20MBCSASJHCDCDJHSASCD*SASSASCDEG3-8CDJHSAS*
21WHBCBMJKEG3-8BM*JKEG5-10JK/JHBMJKJHBMBMJKEG2-7*

<colgroup><col style="width: 30px; font-weight: bold;"><col style="width: 78px;"><col style="width: 66px;"><col style="width: 64px;"><col style="width: 77px;"><col style="width: 75px;"><col style="width: 64px;"><col style="width: 73px;"><col style="width: 76px;"><col style="width: 63px;"><col style="width: 64px;"><col style="width: 71px;"><col style="width: 66px;"><col style="width: 84px;"><col style="width: 76px;"><col style="width: 64px;"><col style="width: 78px;"><col style="width: 176px;"></colgroup><tbody>
</tbody>

Spreadsheet Formulas
CellFormula
A5=CalendarYear
E6=IF(N6="Payday","New Pay Period/Kronos","")
N6=IF(ISERROR(INDEX(paydates,MATCH(N7,paydates,0))),"","Payday")
E7=IF(AND(YEAR(JanOffset+2)=CalendarYear,MONTH(JanOffset+2)=1),JanOffset+2,"")
H7=IF(AND(YEAR(JanOffset+3)=CalendarYear,MONTH(JanOffset+3)=1),JanOffset+3,"")
K7=IF(AND(YEAR(JanOffset+4)=CalendarYear,MONTH(JanOffset+4)=1),JanOffset+4,"")
N7=IF(AND(YEAR(JanOffset+5)=CalendarYear,MONTH(JanOffset+5)=1),JanOffset+5,"")
Q7=IF(AND(YEAR(JanOffset+6)=CalendarYear,MONTH(JanOffset+6)=1),JanOffset+6,"")
T7=IF(AND(YEAR(JanOffset+7)=CalendarYear,MONTH(JanOffset+7)=1),JanOffset+7,"")
E14=IF(N14="Payday","New Pay Period/Kronos","")
N14=IF(ISERROR(INDEX(paydates,MATCH(N15,paydates,0))),"","Payday")
E15=IF(AND(YEAR(JanOffset+9)=CalendarYear,MONTH(JanOffset+9)=1),JanOffset+9,"")
H15=IF(AND(YEAR(JanOffset+10)=CalendarYear,MONTH(JanOffset+10)=1),JanOffset+10,"")
K15=IF(AND(YEAR(JanOffset+11)=CalendarYear,MONTH(JanOffset+11)=1),JanOffset+11,"")
N15=IF(AND(YEAR(JanOffset+12)=CalendarYear,MONTH(JanOffset+12)=1),JanOffset+12,"")
Q15=IF(AND(YEAR(JanOffset+13)=CalendarYear,MONTH(JanOffset+13)=1),JanOffset+13,"")
T15=IF(AND(YEAR(JanOffset+14)=CalendarYear,MONTH(JanOffset+14)=1),JanOffset+14,"")

<tbody>
</tbody>

<tbody>
</tbody>


Excel tables to the web >> Excel Jeanie Html" target="_blank"> Excel Jeanie HTML 4
 
Upvote 0
I'd do something like this. You'll need to account for when you might erroneously change a cell to CLOSED...I'd maybe do a format copy of a pre-defined range of cells (could be on a different - maybe hidden? - sheet, or could be within your main data sheet). I've left that part for you for now - if you can't figure it out let us know and someone will code something up for you.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If (Target.Row - 1) Mod 8 = 0 And Target.Text = "CLOSED" Then
            Select Case UCase(Format(Target.Offset(-2), "ddd"))
                Case "SAT"
                    Target.Offset(4).Interior.Color = 5296274
                Case Else
                    Target.Offset(1, 0).Resize(4, 3).Interior.Color = 5296274
            End Select
    Else
        ' IF TARGET.VALUE <> CLOSED, DO YOU WANT TO CHANGE BACK,
        ' IN CASE YOU PUT "CLOSED" ON THE WRONG DATE?
    End If
End Sub

Note that Closed is not the same as CLOSED. If you don't care about case, then use UCASE(Target.Text).
 
Upvote 0
Russell - thanks for this response. I apologize for not responding at all to this earlier...It is something we do once per year and the beginning of the 3rd qtr. begins the busy season for us and I'm just now getting back to this.

This is working fine; however, I have a questions on if I want to change back if I put "CLOSED" on the wrong date. I can copy the code above to get it to change back; however, how do I color my rows back to the two different alternating colors? I'm using light yellow and white as the alternating colors.
 
Upvote 0
This is the code I have so far:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If (Target.Row - 1) Mod 8 = 0 And Target.text = "CLOSED" Then
            Select Case UCase(Format(Target.offset(-2), "ddd"))
                Case "SAT"
                    Target.offset(4).Interior.Color = 5296274
                Case Else
                    Target.offset(1, 0).Resize(4, 3).Interior.Color = 5296274
            End Select
    Else
    If Target.Value <> "CLOSED" Then
            Select Case UCase(Format(Target.offset(-2), "ddd"))
                Case "SAT"
                    Target.offset(4).Interior.Color = 2
                Case Else
                    Target.offset(1, 0).Resize(4, 3).Interior.Color = 13759225
            End Select
     End If
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,973
Messages
6,122,534
Members
449,088
Latest member
RandomExceller01

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