Conditional formating based on start and stop time - excel

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

Answer 1

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: