Help with time if/then in VBA

[broman5000]

I'm drawing a blank here...essentially I want to highlight (I got that part RGB(255,0,0)) all cells if they greater than 10:30 (currently cells are formatted as general) see below

My spreadsheet looks like the following and my code is below...with no success Please help! data is in column Q

ACTUAL_TIME

10:14

11:37

8:21

10:32

11:04

11:49

Sub test()


Dim i As Long
Dim lastrow As Long
Dim lunch As Long


With ActiveSheet
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    
    End With


For i = 0 To lastrow - 2
If Range("BD5").Offset(i, 0).Value = "Y" And Range("Q5").Offset(i, 0).Value > TimeValue("10:30:00") Then


Range("R5").Offset(i, 0).EntireRow.Interior.Color = RGB(255, 0, 0)
Range("R5").Offset(i, 0).EntireRow.Font.Color = RGB(255, 255, 255)
Range("R5").Offset(i, 0).EntireRow.Font.Bold = True
lunch = lunch + 1
End If
Next i


End Sub

[SamT]

Try moving "End With" after "Next i" This will make the rest of the code apply to the same sheet as LastRow.

The Interior Color Property should only be used with accepted Color Constants, vbRed, vbWhite, etc

THe use of RGBs as Interior Colors result in the nearest color in the ColorIndex series.

To see which ColorIndex is what color: Run

Sub ShowColorIndecies()
Dim rw as Long

For rw = 1 to 56
With Cells(rw, "A")
.Interior.ColorIndex = rw
.Value = rw
End with
Next

With Cells(57, "A")
.Interior.ColorIndex = xlColorIndexAutomatic
.Value = "xlColorIndexAutomatic = " & xlColorIndexAutomatic
End with

With Cells(58, "A")
.Interior.ColorIndex = xlColorIndexNone
.Value = "xlColorIndexNone = " & xlColorIndexNone
End with
End Sub

[Leith Ross]

Hello Broma5000,

This macro worked for the example workbook you posted. Try this with the workbook you will be using and let me know if you have any issues.\

Sub TestA()


    Dim Actual  As Single
    Dim Cell    As Range
    Dim MaxTime As Single
    Dim r       As Long
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        MaxTime = TimeValue("10:30:00")
        
        Set Wks = ActiveSheet
        
        Set Rng = Wks.Range("A5:BD5")
        
        Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)
        If RngEnd.Row < Rng.Row Then Exit Sub


        Application.ScreenUpdating = False
        
            Set Rng = Rng.Resize(RngEnd.Row - Rng.Row + 1)
            
            For r = 1 To Rng.Rows.Count
                ' Column "Q"
                Set Cell = Rng.Item(r, 17)
                On Error Resume Next
                    Actual = TimeValue(Cell.Value)
                    If Err <> 0 Then Actual = 0
                On Error GoTo 0
                ' Column "BD"
                If Cell.Offset(0, 39) = "Y" And Actual > MaxTime Then
                    With Rng.Rows(r)
                        .Interior.Color = RGB(255, 0, 0)
                        .Font.Color = RGB(255, 255, 255)
                        .Font.Bold = True
                    End With
                End If
            Next r


        Application.ScreenUpdating = True


End Sub