Coloring with VBA

[xsmurf]

Hello,

I have a question, because I have a problem regarding a VBA code

I found a code that does only partially what I want.
I'm trying to highlight dates that are equal or lower then the current date (this date is on a different sheet, called Setup and the date is in cell "F3")
If there is no date in the range given no formatting should take place.
And only the range given should be highlighted, and not the rows in between the range.

Can somebody assist me with this problem, it would be highly appreciated.

Sub ChangeColor()
    Dim myDate As Date
    Dim rngCell As Range
    Dim lrow  As Long
     'format the date excluding time
    myDate = FormatDateTime(Now, 2)

    For Each rngCell In Range("C3:BB3", "C27:BB27") 'The 2 ranges I want to be highlighted IF there is a date in it.

   Select Case DateDiff("d", FormatDateTime(rngCell.Value, 2), myDate)
        Case Is >= 0
        rngCell.Interior.ColorIndex = 44
        rngCell.Font.ColorIndex = 55
        Case Is = Empty
        rngCell.Interior.ColorIndex = xlNone

   End Select
    Next

    Exit Sub

End Sub

 

[xsmurf]

@Kenneth Hobson
I really like your VBA solution.

wanted to upload an example, but it doesn't let me

 

[Kenneth Hobson]

dropbox.com, box.net, etc. allow some free file sharing. Upload there and then copy a paste the shared link here. Some have OneDrive. If not enough, try searching for "free shared files sites".

 

[xsmurf]

hopefully this Works:

https://1drv.ms/x/s!ApZQYEbOSYZDgThgz0jXatVwY9c_

 

[Kenneth Hobson]

Sub ChangeColor3()
  Dim myDate As Date, rngCell As Range, lrow As Long
  Dim diff As Long, d As Date
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
  'format the date excluding time
  myDate = FormatDateTime(Worksheets("Setup").Range("F3").Value, vbShortDate)
  If Not IsDate(myDate) Then Exit Sub
  
  'The 2 ranges I want to be highlighted IF there is a date in it.
  On Error Resume Next
  For Each rngCell In Range("C3:BB3,C27:BB27")
    d = FormatDateTime(rngCell.Value, vbShortDate)
    diff = d - myDate
    Select Case True
      Case diff <= 0 And IsDate(d) And d <> 0
        rngCell.Interior.ColorIndex = 44
        'rngCell.Interior.Color = vbRed
        rngCell.Font.ColorIndex = 55
      Case Else
        rngCell.Interior.ColorIndex = xlNone
    End Select
  Next rngCell
  
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub

 

[xsmurf]

Thank you so much for all your help, it works like an charm.
Will study the code, so I can learn from it.

Again thank you