Conditional formating based on start and stop time

Question

Last week, I found an excellent code that I've been looking for. Except that I would like to use conditional formatting vertical, not horizontal as in the original code.

The orginal code is found from: Excel VBA - How do I select a range corresponding to values in previous cells?

I tried to modify the code to suit me, but there is still something wrong and I don't know what.

There is my code:

Sub tee()
    Dim startRow As Long
    Dim endRow As Long
    Dim i As Long
    Dim j As Long

    Dim ws As Excel.Worksheet
    Dim entryTime As Single
    Dim exitTime As Single
    Dim formatRange As Excel.Range

    Set ws = ActiveSheet

     startRow = ws.Range("19:19").Row
     endRow = ws.Range("56:56").Row

    Call clearFormats

     For i = 3 To ws.Cells(1, 1).End(xlToRight).Column
        entryTime = ws.Cells(15, i).Value
        exitTime = ws.Cells(16, i).Value

        Set formatRange = Nothing

      For j = startRow To endRow
            If (ws.Cells(j, 2).Value > exitTime) Then
                Exit For
            End If

             If ((entryTime < ws.Cells(j, 2).Value) And (ws.Cells(j, 2).Value < exitTime)) Then

                If (formatRange Is Nothing) Then
                   Set formatRange = ws.Cells(j, i)
                Else
                   Set formatRange = formatRange.Resize(, formatRange.Rows.Count + 1)

                    End If
            End If
        Next j

        If (Not formatRange Is Nothing) Then
            Call formatTheRange(formatRange, ws.Cells(j, "A").Value)
        End If
    Next i
End Sub



Private Sub clearFormats()

    With ActiveSheet.Range("C19:AA56")
        .clearFormats
        .ClearContents
    End With

End Sub




Private Sub formatTheRange(ByRef r As Excel.Range, ByRef callsign As String)

  r.HorizontalAlignment = xlCenter
  r.Merge
  r.Value = callsign

    ' Apply color
    With r.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .Color = 3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

    ' Apply borders
    With r.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With r.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With r.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
     End With
     With r.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
     End With
End Sub

The last two is ordinary code. I have change only the first one.

I don't have a lot of programming with VBA, but I'm trying hard.

Jukkis

Can you please state more clearly what you expect your code to do - and could you try to cut it down to the smallest example that shows the problem you are getting? This is right now a very poorly phrased question with way too much unnecessary code in it. — Floris, Dec 01 '13 at 17:46
We have few people who are working for example from 7.45 am to 6.15 pm and other from 8.45 to 16.30 pm.I put their start time on the same row -row 15 (C15) and stop time to row 16 (C16). Based on these times I like to see their working hours on graphics. I have cells (B19, B20, B21...) containing the start times. Now I hope that cell, which is in the right side on working times (C19, C20; C21...) is going to be red and the others cells too, which are less than stop time. Code I have modified make only one cell red - in fact two, but they are horizontal. — Jukkis, Dec 01 '13 at 19:37
The ordinary code fill cells based on these times horizontally. I want to "my" code to do the same, but vertically. I hope that helps you understand, what I'm looking for and what is wrong about the code — Jukkis, Dec 01 '13 at 19:37
Can you show (screen shot or table) a few cells with values and the coloring you want - this is still very hard to understand from your description. — Floris, Dec 01 '13 at 19:45
sorry.. it says "You need at least 10 reputation to post images" I tried add the pictures — Jukkis, Dec 01 '13 at 19:51
Post the pictures on another file sharing site (e.g. imgur.com) and post a link. — Floris, Dec 01 '13 at 19:52

Floris · Accepted Answer · 2013-12-04T00:40:07.770

0

The picture tells a thousand words! Here is some code that works. I have simplified your code considerably, rather than trying to learn what you did (and why it didn't work). Feel free to compare with your original, and figure out why one works when the other didn't.

Note - I use the MATCH function to find the rows where you start/end, then format the entire column in a single step. Since I made a smaller sheet, some of the row/column numbers are different - it should be easy to see where you have to change things in the code to work for you.

Option Explicit

Sub makeTimeGraph()
    Dim startRow As Long
    Dim endRow As Long
    Dim entryTimeRow As Long
    Dim entryTimeFirstCol As Long

    Dim ws As Excel.Worksheet
    Dim timeRange As Range
    Dim c
    Dim timeCols As Range
    Dim entryTime
    Dim exitTime
    Dim formatRange As Excel.Range
    Dim eps
    eps = 1e-06 ' a very small number - to take care of rounding errors in lookup


    ' change these lines to match the layout of the spreadsheet
    ' first cell of time entries is B1 in this case:
    entryTimeRow = 1
    entryTimeFirstCol = 2
    ' time slots are in column A, starting in cell A3:
    Set timeRange = Range("A3", [A3].End(xlDown))

    ' columns in which times were entered:
    Set ws = ActiveSheet
    Set timeCols = Range("B1:H1) ' select all the columns you want here, but only one row

    ' clear previous formatting
    Range("B3", ws.Cells.SpecialCells(xlCellTypeLastCell)).clearFormats

    ' loop over each of the columns:
    For Each c In timeCols.Cells
      If IsEmpty(c) Then Goto nextColumn
      entryTime = c.Value
      exitTime = c.Offset(1, 0).Value
      startRow = Application.WorksheetFunction.Match(entryTime + eps, timeRange) + timeRange.Cells(1.1).Row - 1
      endRow = Application.WorksheetFunction.Match(exitTime - eps, timeRange) + timeRange.Cells(1.1).Row - 1
      Set formatRange = Range(ws.Cells(startRow, c.Column), ws.Cells(endRow, c.Column))
      Call formatTheRange(formatRange)
nextColumn:
    Next c

End Sub


Private Sub formatTheRange(ByRef r As Excel.Range)

  r.HorizontalAlignment = xlCenter
  r.Merge

    ' Apply color
    With r.Interior
        .Pattern = xlSolid
        .Color = 3
        .TintAndShade = 0.8
    End With

End Sub

Here is the result:

enter image description here

edited Dec 04 '13 at 00:40

answered Dec 01 '13 at 21:30

Floris

45,857
6
70
122

Thank You very much that you helped me. Your code is working fine and I understood most of it and it was easy to understand where do I put the start time, stop time and so on. Now I noticed that my picture was not perfect. If someone is not at job, he has not working time (entryTime and exitTime cells are empty). Now the code stop working before the empty cell. And finaly when the week is over in column H (see picture, http://jukkis.imgur.com), the code should be "stop" because there may be some text or numbers in column I. Would you like to help me a little bit more, please? – Jukkis Dec 02 '13 at 19:57
Change the line that starts `Set timeCols=Range("C1:H1")` to include the empty column (but nothing past column H). And in the `For` loop test for empty cell with `If IsEmpty(c) Then Next c` - I _think_ that should work... – Floris Dec 02 '13 at 22:59
The empty cell test is not working or I don't know how to use it. VBA gives an error message: Compile error: Next without For. – Jukkis Dec 03 '13 at 19:35
My bad... mixing my languages. `Then Next` is not valid. And VBA doesn't have a `Continue` statement either. You can either use an if/else, or a `GoTo`. This is one of the rare cases where I think a `GoTo` is actually legitimate (it is effectively what a `Continue` would do if it existed...). I have edited the code - it should now do exactly what you asked for. – Floris Dec 04 '13 at 00:40
Now the code works fine. I am grateful that there are those who help patiently and advice us who are quite at the beginning of VBA, but are trying to solve may be too complicated code. However, it may be possible that some day I ask more help, because I guess that one day I would like to additional features to this code. Would it be Ok? Thank you again very much – Jukkis Dec 04 '13 at 08:41
@jukkis - glad to help someone who shows a desire to learn. You "repay" by learning, then helping others. If you have more problems ask a new question; good questions are welcome (note how your question "got better" - it is important to ask the best question you can). If it relates to this one, include a link. You could also add a link from here (in comment) to new question if they are related. Good luck! – Floris Dec 04 '13 at 16:37
I have modify the code a little bit and now I don't understand what is wrong. I put new images to http://jukkis.imgur.com Now the code checks the row 3 and based on cells name, make a conditional format the cells below. In your originally code the conditional format area cells are connected together, but now each cell is individually conditional format. That's because I want to calculate number of employees during the day in column E. – Jukkis Dec 14 '13 at 20:41
I've also added the automatic calculation, if you change the cells value of the range B4:Q4. When I added the automatic calculation, then I noticed that the program stop on an error 400 if cell in the row 5 is empty. Shall I add some kind of error check if the cell is empty? I Have also a [new questions](http://stackoverflow.com/questions/20587997/counting-conditional-formatting-cells-by-colorindex) – Jukkis Dec 14 '13 at 20:43

Conditional formating based on start and stop time

1 Answers1

Linked