Jan 10 2020 09:53 AM
What I'm trying to do is quickly and automatically figure out how many employees I have scheduled for each quarter hour. I am so close to completing this project but I have one issue to overcome. I have drop downs for entering the time and and out. I used conditional formatting using a formula =AND(D$1>=$B2,E$1<=$C2) to fill in each cell during that time frame with a color. I then have a UDF listed below to count the cells with color. I have under the Rwo "actual" each quarter hour totals. The formula I have in each one of those cells is =COUNTConditionColorCells($D$2:$D$15,CM17). The issue is that its not calculating correctly. If I enter a time of 3am to 10am it will show 1 in every column even outside of that time range. Also If I enter a time of 4pm to 7pm it doesn't even calculate that. I've attached my workbook. I really would appreciate any help on this.
Function COUNTConditionColorCells(CellsRange As Range, ColorRng As Range)
Application.Volatile
Dim Bambo As Boolean
Dim dbw As String
Dim CFCELL As Range
Dim CF1 As Single
Dim CF2 As Double
Dim CF3 As Long
Bambo = False
For CF1 = 1 To CellsRange.FormatConditions.Count
If CellsRange.FormatConditions(CF1).Interior.ColorIndex = ColorRng.Interior.ColorIndex Then
Bambo = True
Exit For
End If
Next CF1
CF2 = 0
CF3 = 0
If Bambo = True Then
For Each CFCELL In CellsRange
dbw = CFCELL.FormatConditions(CF1).Formula1
dbw = Application.ConvertFormula(dbw, xlA1, xlR1C1)
dbw = Application.ConvertFormula(dbw, xlR1C1, xlA1, , ActiveCell.Resize(CellsRange.Rows.Count, CellsRange.Columns.Count).Cells(CF3 + 1))
If Evaluate(dbw) = True Then CF2 = CF2 + 1
CF3 = CF3 + 1
Next CFCELL
Else
COUNTConditionColorCells = "NO-COLOR"
Exit Function
End If
COUNTConditionColorCells = CF2
End Function
Jan 13 2020 02:00 AM
Hi, I haven't tried to use VBA to count conditional formatting before so thank you for this challenge.
The issue here is that you are always counting the number of cells in column D (from the original conditional formatting) because the ConvertFormula function resizes the row but not the column. My solution is to add a column resize parameter to your final ConvertFormula statement as follows:
dbw = Application.ConvertFormula(dbw, xlR1C1, xlA1, , ActiveCell.Resize(CellsRange.Rows.Count, CellsRange.Columns.Count).Cells(CF3 + 1, CFCELL.Column - 3))
Please remember that this works because your conditional formula is based on column D. So, when you calculate column D the resize parameter is 4-3=1, calculate column E is 5-3=2 and so on. Therefore, if you have other spreadsheets with different conditional formatting rules, you may need to change the "-3" in this calculation. 🙂
Hope this helps.
Jan 13 2020 04:34 AM - edited Jan 14 2020 06:33 AM
I wonder why you would go so long as to try counting cells based on format using VBA. Perhaps you want to consider a different approach. Enter the following formula in D2 and copy it down and across.
=IFERROR(1/(AND($B2<>"",$C2<>"")/AND(D$1>=$B2,D$1<$C2)),"")
It will test if start and stop times are entered and return a blank for quarters not scheduled and 1 for those that are. In row 17 you can then simply sum the cells above. Add conditional formatting to your liking.
Jan 13 2020 05:14 AM
Jan 14 2020 06:06 AM
I found an issue with both of our solutions. Example is that if I have an employee scheduled 8 am to 4 pm with each cell being by the quarter hour what is happening is its adding an extra 1 in the cell that's technically the 4 pm to-4:15 pm cell. the cell that is labeled 3:45 pm would technically be 3:45 pm to 4 pm. Any thoughts or suggestions on how to deal with this?
Jan 14 2020 06:28 AM - edited Jan 14 2020 06:31 AM
Have a look at the attached workbook. It's the one I used earlier to test your "problem". 8am to 4pm equals to 8 hours, i.e. 32 quarters. In my schedule, 32 columns are coloured, the last one being 3.45pm, marking the beginning of the last quarter. I believe that's correct.
Jan 14 2020 07:24 AM
Jan 14 2020 07:29 AM
SolutionYou may mark it as a "Best solution". Then you'll make me really happy. Haha!
Jan 14 2020 07:29 AM
SolutionYou may mark it as a "Best solution". Then you'll make me really happy. Haha!