PDA

View Full Version : Any suggestions on making this code faster



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

SamT
07-21-2013, 05:54 PM
Option Explicit
Sub ConditionalFormatCells(DashDates As Range)
Dim Cel As Range 'Explicitly declared Variables are faster
Application.ScreenUpdating = False
For Each Cel In DashDates
Select Case Cel.Value
'Assumes GetSOPDate is alway
a later than Now - 2 years
Case Is = &quot;N/A&quot;
Cel.Interior.ColorIndex = 3
Case Is < Now - 730
'How critical is exact 2yrs date? 730 days = 2 yrs, except leapyears
'In fact, if this is for training and you want to have 30 days leeway
'use 700 days
Cel.Interior.ColorIndex = 4
Case Is < GetSOPDate(Cells(1, Cel.Column), [SOPrng])
'The cell contains a date less than a certain date held on another sheet
Cel.Interior.ColorIndex = 5
Case Else
'The cell passes all the conditions make it white
'ColorIndex constant xlColorIndexNone = no fill = looks white
Cel.Interior.ColorIndex = 2
End Select
Next
Application.ScreenUpdating = True
End Sub

'Explicitly declared Function data types are faster
Function GetSOPDate(SOP As String, rng As Range) As Long
GetSOPDate = rng.Find(SOP).Offset(0, 2).Value

'Where is SOPrng defined? 'IF GetSOPDate is in scope of SOPrng, faster to refer to it locally
'Function GetSOPDate(SOP As String) As Long
'GetSOPDate = SOPrng.Find(SOP).Offset(0, 2).Value
End Function v