TrinColll
07-21-2013, 04:01 PM
Hi I have a dynamic excel spreadsheet that looks up dates for training based on the employee's in departments. The dates that are loaded need to be conditionally formatted. I had originally done this using excel conditional formatting. I however ran into a problem. I decided to add some more functionality to my program by having it email all the employees who had dates that were colored (ie out of date). Unfortunately VBA code does not recognize interior colors that have been conditionally formatted. So I decided to write a sub in vba that formats the cells. It is now slower than the conditional formatting that I had implemented before. Could anyone make some suggestions to make it faster?
Sub ConditionalFormatCells(DashDates As Range)
Application.ScreenUpdating = False
For Each cel In DashDates
If cel.Value <> "" Then
If cel.Value = "N/A" Then
cel.Interior.ColorIndex = 3
ElseIf DateDiff("yyyy", cel.Value, Now) > 2 Then ' if the cell contains a date that is greater than 2 years old
cel.Interior.ColorIndex = 4
ElseIf cel.Value < GetSOPDate(Cells(1, cel.Column), [SOPrng]) Then ' if the cell contains a date less than a certain date held on another sheet
cel.Interior.ColorIndex = 5
Else: cel.Interior.ColorIndex = 2 ' if the cell passes all the conditions make it white
End If
Else: cel.Interior.ColorIndex = 2 ' if the cel has no content make it white
End If
Next
Application.ScreenUpdating = True
End Sub
Function GetSOPDate(SOP As String, rng As Range)
For Each thing In rng
If thing = SOP Then
GetSOPDate = thing.Offset(0, 2)
End If
Next
End Function
Sorry for whatever reason i cant add a vba tag ill try to tomorrow at work my macs not letting me
Sub ConditionalFormatCells(DashDates As Range)
Application.ScreenUpdating = False
For Each cel In DashDates
If cel.Value <> "" Then
If cel.Value = "N/A" Then
cel.Interior.ColorIndex = 3
ElseIf DateDiff("yyyy", cel.Value, Now) > 2 Then ' if the cell contains a date that is greater than 2 years old
cel.Interior.ColorIndex = 4
ElseIf cel.Value < GetSOPDate(Cells(1, cel.Column), [SOPrng]) Then ' if the cell contains a date less than a certain date held on another sheet
cel.Interior.ColorIndex = 5
Else: cel.Interior.ColorIndex = 2 ' if the cell passes all the conditions make it white
End If
Else: cel.Interior.ColorIndex = 2 ' if the cel has no content make it white
End If
Next
Application.ScreenUpdating = True
End Sub
Function GetSOPDate(SOP As String, rng As Range)
For Each thing In rng
If thing = SOP Then
GetSOPDate = thing.Offset(0, 2)
End If
Next
End Function
Sorry for whatever reason i cant add a vba tag ill try to tomorrow at work my macs not letting me