Macro for conditional format (to avoid slowing down file)

Brass Contributor

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? 

 

Celia9_0-1664952583745.png

 

5 Replies

@Celia9 

Do you mean that you want to highlight the holidays by direct formatting instead of conditional formatting?

Yes, I think I do. But it still should be based on the data like the conditional format is setup.

@Celia9 

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

@Hans Vogelaar 

 

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

@Celia9 

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