L
Leslie
Here is my code: I am getting an Error 13 - Type mismatch. Any ideas on why.
Thanks.
Sub CFormat()
Dim rng As Range, cell As Range
Dim ncol As Integer, lrow As Long
Dim pcnt As Double, divisor As Double
'Ace is sheet name
ThisWorkbook.Worksheets("Ace").Activate
' 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(20, 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 percentage
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
Thanks.
Sub CFormat()
Dim rng As Range, cell As Range
Dim ncol As Integer, lrow As Long
Dim pcnt As Double, divisor As Double
'Ace is sheet name
ThisWorkbook.Worksheets("Ace").Activate
' 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(20, 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 percentage
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