Forum Discussion

Celia9's avatar
Celia9
Brass Contributor
Oct 05, 2022

Macro for conditional format (to avoid slowing down file)

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 but...
Macros and VBA
Celia9's avatar
Celia9
Brass Contributor
Oct 07, 2022
Yes, I think I do. But it still should be based on the data like the conditional format is setup.
HansVogelaar's avatar
HansVogelaar
MVP
Oct 07, 2022

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
  • Celia9's avatar
    Celia9
    Brass Contributor
    Oct 18, 2022

    HansVogelaar 

     

    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

    • HansVogelaar's avatar
      HansVogelaar
      MVP
      Oct 18, 2022

      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

Resources