Advanced VBA Conditional Formatting & Field Population

[Jason Golden]

I have a rather complex spreadsheet that I would like to automate. I'm sure
it can be done, just not sure how.

My workbook has 3 sheets, the first is a schedule broken up into blocks,
left to right the blocks are labled by the day of the week (Monday,
Tuesday...) Top to Bottom labeled by the week number (1, 2, 3, 4 ,5).

With in each block is a list of People (Smith; Doe...) and related elements
(Room, %, Start Time).

The Second sheet is a mirror of the first, data is linked to the first.
This allows me to apply color coding without impacting the appearance of the
first sheet. If my conditional formatting works this sheet would be
eliminated.

The third sheet is a key, contains a list of names from the first sheet and
a corresponding Index Color ie Smith 22

My goal is to apply the related index color to all instances of smith that
appear on the first sheet where the % is greater than 0.

The color would only be applied to Name, Room, % and Start Time Field within
a given block.

Example:

Smith appears in the 1 Monday, 4 Friday and 2 Tuesday Blocks. I want each
instance to be colored the same ( the % field would be populated for each
instance).

I would attach the file to this posting, but that doesn't appear to be an
option.

I'm pretty sure this would require VBA code which I'm comfortable with.

 

[Tim Williams]

It's not clear from your explanation how the person, room , % and
Start time are entered. Is each one in its own cell, or are they all
combined in one cell ?

Tim

 

[Jason Golden]

Each is their own cell.

What I want to do is color a group of cells based on the value in 2 cells...
so if Surg/Grp = Block 1 and % >0 then color all three (Surg/Grp, RM & %)
fields based on assigned color in index. The index would be on a separate
sheet connecting the block 1 to a specific index color like Blue... so on the
schedule any where Block 1 has a % > 0 color it blue (or what ever color is
assigned to that block on the index sheet).

Hope that clears it up.

Sample:
Monday Tuesday
Wednesday
Week 1 Surg/Grp RM % Surg/Grp RM %
Surg/Grp RM %
Block 1 1 80% Block 1 1
80% Block 1 1 0
Block 2 2 0

Week 2 Block 1 1 15% Block 1 1 15%
Block 1 1 0
Block 2 2 10%

 

[Tim Williams]

I'm still a little unlear on your layout.
If you'd like to email me an example I will try to help you out.

Tim
t i m j w i l l i a m s at g m a i l dot c o m

 

[Jason Golden]

Tim, I sent you an example via e-mail

I'm still a little unlear on your layout.
If you'd like to email me an example I will try to help you out.

Tim
t i m j w i l l i a m s at g m a i l dot c o m






.

 

[Jason Golden]

Thank you Tim for your help! The script you provided works perfectly.

I've included it below in case anyone else has a similar need.

Option Explicit

Const TOT_BLOCKS As String = "Total Blocks"


Sub ColorCodeSchedulePen()

Dim rng As Range, c As Range
Dim x As Integer
Dim tmp As String, perc
Dim cIndex As Integer, fIndex As Integer
Dim f As Range
Dim rngColors As Range

Set rngColors = ThisWorkbook.Sheets("Block Release").Range("L5:L58")

'Range for Monday...
Set rng = ThisWorkbook.Sheets("Pen Block Schedule").Range("B4:B58")

'loop through each day
For x = 1 To 5
For Each c In rng.Cells
tmp = Trim(c.Value)
perc = c.Offset(0, 3).Value
cIndex = xlNone
fIndex = xlAutomatic

If Len(tmp) > 0 And tmp <> TOT_BLOCKS _
And IsNumeric(perc) And Len(perc) > 0 Or perc = "RLS" Then

Set f = rngColors.Find(tmp, , xlValues, xlWhole)
If Not f Is Nothing Then
cIndex = f.Interior.ColorIndex
fIndex = f.Font.ColorIndex
End If

End If

With c.Resize(1, 6)
.Interior.ColorIndex = cIndex
.Font.ColorIndex = fIndex
End With
Next c

Set rng = rng.Offset(0, 6) 'next day
Next x

End Sub