Oct 04 2022 11:52 PM
Hi all,
I have a conditional format like this (also in attached file). It works great, but my file gets really slow because of it.
Can I transfer this into a macro, so I can just press a button once a week, the new conditional format gets pulled and stored?
@Hans Vogelaar Could you help me with this?
Oct 05 2022 02:45 AM
Do you mean that you want to highlight the holidays by direct formatting instead of conditional formatting?
Oct 07 2022 02:08 AM
Oct 07 2022 02:27 AM
Try this:
Sub HighlightHolidays()
Dim hol As Variant
Dim emp As String
Dim dtm As Date
Dim i As Long
Dim r As Long
Dim c As Long
Application.ScreenUpdating = False
hol = Range("TableHolidays").Value
For i = 1 To UBound(hol)
dtm = hol(i, 2)
r = Range("A:A").Find(What:=dtm, LookAt:=xlWhole).Row
emp = hol(i, 1)
c = Range("1:1").Find(What:=emp, LookAt:=xlWhole).Column
Cells(r, c).Interior.Color = RGB(217, 217, 217)
Next i
Application.ScreenUpdating = True
End Sub
Oct 18 2022 04:20 AM
I just got to test it just now, it works, but when I transfer the code to my own file it stops working.
The ranges are slightly different, I changed them in your posted file as well. The changes I have made work in your file, but not in mine. Could you help me out?
The error I get: Object variable or With block variable not set
Sub HighlightHoliday()
Dim hol As Variant
Dim emp As String
Dim dtm As Date
Dim i As Long
Dim r As Long
Dim c As Long
Application.ScreenUpdating = False
hol = Range("TableHolidays").Value
For i = 1 To UBound(hol)
dtm = hol(i, 2)
r = Range("G:G").Find(What:=dtm, LookAt:=xlWhole).Row
emp = hol(i, 1)
c = Range("14:14").Find(What:=emp, LookAt:=xlWhole).Column
Cells(r, c).Interior.Color = RGB(217, 217, 217)
Next i
Application.ScreenUpdating = True
End Sub
Oct 18 2022 04:51 AM
The macro runs without error when I try it, but Excel can be very finicky when you try to search for a date using VBA. Does this work for you?
Sub HighlightHolidays()
Dim hol As Variant
Dim emp As String
Dim dtm As Date
Dim i As Long
Dim r As Long
Dim r1 As Long
Dim r2 As Long
Dim c As Long
Application.ScreenUpdating = False
r1 = 15 ' row of first date
r2 = Cells(Rows.Count, "G").End(xlUp).Row ' row of last date
hol = Range("TableHolidays").Value
For i = 1 To UBound(hol)
dtm = hol(i, 2)
For r = r1 To r2
If Range("G" & r).Value = dtm Then Exit For
Next r
emp = hol(i, 1)
c = Range("14:14").Find(What:=emp, LookAt:=xlWhole).Column
Cells(r, c).Interior.Color = RGB(217, 217, 217)
Next i
Application.ScreenUpdating = True
End Sub