PDA

View Full Version : Help with time if/then in VBA



broman5000
02-03-2017, 11:18 AM
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
02-03-2017, 03:34 PM
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
02-03-2017, 07:59 PM
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