You can run it automatically each time the workbook is open. Put this code
in the ThisWorkbook sheet (module):

Sub Workbook_Open
Call cFormat
end sub

OR (and I'll leave to work it out!) you could add a button to the form which
calls the macro. HINT_ click the Forms toolbar and select button control. In
the Assign Macro form select CFormat then OK.

FYI

Attached code clears ONLY colurs used in this worksheet:

Sub CFormat()
'
Dim rng As Range, cell As Range
Dim ncol As Integer, lrow As Long
Dim pcnt As Double, divisor As Double

ThisWorkbook.Worksheets("Sheet1").Activate ' <=== Change to your w/sheet

' Find column for current Month (add 5 to start in colum F onwards)
ncol = Application.Match(Range("A2"), Range("F3:q3"), 0) + 5

' Find last row of data in column A
lrow = Cells(Rows.Count, 1).End(xlUp).Row
' Clear colours used in this macro
Set rng = Range("F9:Q1" & lrow)
For Each cell In rng
Select Case cell.Interior.ColorIndex
Case Is = 4, 35, 36, 7, 54, 3
cell.Interior.ColorIndex = xlNone
End Select
Next cell

' Set range to cells for current month starting row 9
Set rng = Range(Cells(9, ncol), Cells(lrow, ncol))

' Set Divisor for current month
divisor = Cells(5, ncol)

' Loop through all cells in range
For Each cell In rng
' Check length of cell in column A
If Len(cell.Offset(0, -(ncol - 1))) = 4 Then
' Calculate perecentage
If Application.IsNumber(cell) Then ' Is this cell a number ?
pcnt = (cell / divisor) * 100
cell.Select
' Set colorindex based on percentage
Select Case pcnt
Case Is 100
Selection.Interior.ColorIndex = 4
Case Is = 90
Selection.Interior.ColorIndex = 35
Case Is = 80
Selection.Interior.ColorIndex = 36
Case Is = 70
Selection.Interior.ColorIndex = 7
Case Is = 1
Selection.Interior.ColorIndex = 54
Case Else
Selection.Interior.ColorIndex = 3
End Select
Else
cell.Select
Selection.Interior.ColorIndex = 3
End If
End If
Next cell

End Sub

"Leslie" wrote:

One more thing. How is the coding executed? Is it when I open the
worksheet or workbook or do I have to press F5 all the time? Thanks.

"Leslie" wrote:

Yeah! Its working BUT, another But, Very oddly it colored all the blank cells
up to row 102 and then just stopped. I can't imagine why that is.

"Toppers" wrote:

Add these lines after End Select

Else
cell.Select
Selection.Interior.ColorIndex = 3


i.e.

End Select
* Else
* cell.Select
* Selection.Interior.ColorIndex = 3
End If

"Leslie" wrote:

Thanks its working great. The only thing that is not working is if the cell
is empty or blank it should also have a background color of red. I've been
trying to figure this out but no luck so far. Thanks again for all your
help.

"Toppers" wrote:

Hi,
The simplest way would be to clear ALL months at the beginning of
the macro and just re-populate the current month.

Range("F9:Q100").Select <=== change to 100 to whatever you think the max
roes are going to be.
Selection.Interior.ColorIndex = xlNone ' Clears the colours

Place this code at the start of the macro - after DIM statements.

HTH


"Leslie" wrote:

Thanks so much for all your help that was so tricky for me. May I ask one
more question. I tried it out and everything works great but I think it is
missing something. Once July comes or any month thereafter I want it to
clear out the background colors from the previous month and only have the
current month highlighted. Is that possible to do?

"Toppers" wrote:

Check the END IF are all there! It works OK on my machine!

"Leslie" wrote:

It doesn't like the "Next Cell" at the bottom of the code. Thanks.

"Toppers" wrote:

Hi again,
You will get your error message if the cell is blank so I
have added a test for cell value being a number.

HTH

Sub CFormat()
'
Dim rng As Range, cell As Range
Dim ncol As Integer, lrow As Long
Dim pcnt As Double, divisor As Double

ThisWorkbook.Worksheets("Sheet1").Activate ' <=== Change to your w/sheet
' Find column for current Month (add 5 to start in colum F onwards)
ncol = Application.Match(Range("A2"), Range("F3:q3"), 0) + 5

' Find last row of data in current month column
lrow = Cells(Rows.Count, ncol).End(xlUp).Row

' Set range to cells for current month starting row 9
Set rng = Range(Cells(9, ncol), Cells(lrow, ncol))

' Set Divisor for current month
divisor = Cells(5, ncol)

' Loop through all cells in range
For Each cell In rng
' Check length of cell in column A
If Len(cell.Offset(0, -(ncol - 1))) = 4 Then
' Calculate perecentage
If Application.IsNumber(cell) Then ' Is this cell a number ?
pcnt = (cell / divisor) * 100
cell.Select
' Set colorindex based on percentage
Select Case pcnt
Case Is 100
Selection.Interior.ColorIndex = 4
Case Is = 90
Selection.Interior.ColorIndex = 35
Case Is = 80
Selection.Interior.ColorIndex = 36
Case Is = 70
Selection.Interior.ColorIndex = 7
Case Is = 1
Selection.Interior.ColorIndex = 54
Case Else
Selection.Interior.ColorIndex = 3
End Select
End If
End If
Next cell

End Sub


"Leslie" wrote:

Okay, I've confused myself. The run-time error is 1004 after all. I think
it is stuck at:

ncol = Application.Match(Range("CurMonth"), Range("HdrMonths"), 0) + 5

but since I am new to this VBA stuff I most likely am wrong. Does it have
something to do with "ncol". Thanks.

"Toppers" wrote:

Hi,
Try this: insert this code into a general module.

I have defined the cell A2 as a named range called "CurMonth" and the month
headers as a range "HdrMonths".

Sub CFormat()
'
Dim rng As Range, cell As Range
Dim ncol As Integer, lrow As Long
Dim pcnt As Double, divisor As Double

Thisworkbook.Worksheets("Sheet1").activate <=== Change to your w/sheet

' Find column for current Month (add 5 to start in colum F onwards)
ncol = Application.Match(Range("CurMonth"), Range("HdrMonths"), 0) + 5

' Find last row of data in current month column
lrow = Cells(Rows.Count, ncol).End(xlUp).Row

' Set range to cells for current month starting row 9
Set rng = Range(Cells(9, ncol), Cells(lrow, ncol))

' Set Divisor for current month
divisor = Cells(5, ncol)

' Loop through all cells in range
For Each cell In rng
' Calculate perecentage
pcnt = (cell / divisor) * 100
cell.Select
' Set colorindex based on percentage
Select Case pcnt
Case Is 100
Selection.Interior.ColorIndex = 4
Case Is = 90
Selection.Interior.ColorIndex = 35
Case Is = 80
Selection.Interior.ColorIndex = 36
Case Is = 70
Selection.Interior.ColorIndex = 7
Case Is = 1
Selection.Interior.ColorIndex = 54
Case Else
Selection.Interior.ColorIndex = 3
End Select
Next cell

End Sub


HTH

"Leslie" wrote:

First, the formatting will only highlight certain cells in a column when the
column header in Row 3 is the current month which is tied to A2 which is
=Text(now(),"mmm"). Second, only those cells in rows in which Column A has
four digit letters or numbers will be highlighted. What I need is if, for
example, "Col F Row 9" / "Col F Row 5" = 200% then the cell background will
be shaded bright green. Row 5 is static and used as the divisor for all. The
conditions a if the percent is 100.1% or greater then background of cell
is bright green, if percent is 90-100% then light green, if percent is
80-89.9% than light yellow, if percent is 70-79.9% than pink, if 1-69.9% then
purple, if percent is 0 or blank then red. The columns that contain the data
are columns F-P. Is there any way to automate this process. Thanks in
advance. I am very new to VBA.

Col F Col G Col H Col I Col J Col k Col L
Row 3 Jan Feb Mar Apr May Jun Jly

Row 5 $500 $500 $500 $750 $750 $750 $1,000

Row 9 $1000 $750 $500 $0 $1500 $900 $500
Many Rows just like Row 9