It is stopping when it hits a #DIV/0 but once we have column A included in
the code then that won't happen but there will be blanks.

"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