Complicated VBA Conditional Formatting

[Toppers]

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]

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]

Becaues (I am "guessing") row 102 is the last non-blank cell in the current
month; this what lrowl calculates. If you want to use column A as the
delimeteri .e column A is always the longest, then change ncol in the lrow
statement to 1 i.e.

lrow = Cells(Rows.Count, 1).End(xlUp).Row.

You could then modify the code to clear the colours as below and move AFTER
the lrow line.

Range("F9:Q" & lrow).Select
Selection.Interior.ColorIndex = xlNone

 

[Leslie]

Thanks again. That did fix it even though row 102 was not the last non-blank
cell in the current month. Regarding the clearing color with the code we are
using it clears out other coloring I have in certain rows. Is there a way to
limit the clearing of colors to just what we coded?

 

[Leslie]

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.

 

[Toppers]

If the other colours you refer to are in the range of data we are analysing,
i.e. F9 (F20) to Qnnn, then it will require testing EVERY cell to see if it
is a colour we used and then change it to blank.

 

[Toppers]

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