Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

optimize created excel function 1

Status
Not open for further replies.

hrm1220

Technical User
Joined
Aug 31, 2005
Messages
134
Location
US
The issue I have is it’s taking 10 seconds to calculate. This is too long and I’m trying to figure out where I can make this function more efficient.
I'm using Excel 2003

I have 2 ranges to compare from.

The 1st range is the dates that are the Baseline (what it’s suppose to be complete)

The 2nd range is the dates that are the Planned (actual dates)

I’m trying to have the reference date be compared to the 1st range to see if it’s on time and then look at the 2nd range to see if it’s done and if it’s late
BL=Baseline Pl=Planned
This is my data example:
BL Start Date BL Step 2 BL Step 3 Pl Start Date Pl Step 2 Pl Step 3 Late Act. 16Dec08 17Dec08
12/16/2008 12/18/2008 12/23/2008 12/17/2008 12/19/2008 12/27/2008 Late Start Start Start-L
12/16/2008 12/18/2008 12/23/2008 12/16/2008 12/19/2008 12/26/2008 Late 3 Start Start-L

And here’s the function I’ve created:

CODE
Function LM2(RefDate, Namerng As Range, BLrng As Range, Plrng As Range)

Set BL = Cells(BLrng.Row, BLrng.Column + (Application.Match(RefDate, BLrng, 1) - 1))

Set Pl = Cells(Plrng.Row, Plrng.Column + (Application.Match(RefDate, BLrng, 1) - 1))

Set x = Cells(Namerng.Row, Namerng.Column + (Application.Match(RefDate, BLrng, 1) - 1))
If RefDate > Pl Then
Set BL = Cells(BLrng.Row, BLrng.Column + (Application.Match(RefDate, BLrng, 1)))

Set Pl = Cells(Plrng.Row, Plrng.Column + (Worksheet.Match(RefDate, BLrng, 1)))

Set x = Cells(Namerng.Row, Namerng.Column + (Application.Match(RefDate, BLrng, 1)))

End If

If RefDate <= BL.Value Or RefDate > Pl.Value Then
LM2 = x.Value
ElseIf RefDate <= Pl.Value And Pl.Value > BL.Value Then
LM2 = x.Value & "-L"
End If

End Function

Any ideas would be greatly appreciated.
 



"It either doesn't update the cells or it still gives me object define error."

On what statement? Use the Debug Button.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 




If you wish, send me a copy of your workbook, cleaned of all but 2 or 3 rows of data AND the headings, and any other sheets deleted, to...

ii36250 at bellhelicopter dot textron dot com

naturally replacing the at and dots accordingly.

Post back that you either did or did not.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
for the HeadingsNM is row 1, for headingsBL and HeadingsPL is in row 2.

I get the object define error on the
Code:
 theMatch = Application.Match( _
                CLng(Cells(1, iCol).Value), _
                Intersect(Target.EntireRow, [HeadingsBL].EntireColumn), 1)

again, sorry for not understanding the code you provided.
 
I just sent it to you. Please let me know if you don't receive it.
 



Got it!

You have the eadingsNM in row 1 as ...
[tt]
Start Step 2 Step 3 Step 4 Step 5
[/tt]
in the same columns as BL. Where did THAT come from? NOTHING in ANY of your previous postings that refered to this. This is SIGNIFICANT!!!

Please EXPLAIN!!! We've got to UNDERSTNAD what you are trying to do if you want some help! Can't figure EVERYTHING out by osmosis.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
in row 1 it's the short heading of the the Baseline in row 2. the customers don't want to see "Baseline Start" just "Start". So I put the headings in row 1. If it's better to put it in the code then I will.
 




If you were entering YOUR FUNCTION in S3 exactly what range references would you enter in your function? Please copy and paste your function from S3.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
in cell "S3" it would be:
=LM2(S$2,$G$1:$K$1, $G3:$K3,$L3:$P3). This currently will give me a #Value error (which is correct for now).
 
sorry I hit submit post instead of edit.

and in cell AI3 the formula would be:
=LM2(AI$2,$G$1:$K$1, $G3:$K3,$L3:$P3). This currently will give me a "Start" (which is correct),since this is the same date as in cell G3 ("Baseline Start Date" colum).
 



replace the for...next loop with this...
Code:
        For iCol = Cells(2, "S").Column To Cells(2, "S").End(xlToRight).Column
           On Error Resume Next
           theMatch = Application.Match( _
                CLng(Cells(2, iCol).Value), _
                Intersect(Target.EntireRow, [HeadingsBL].EntireColumn), 1)
            If IsError(theMatch) Then
                Err.Clear
            Else
                Pl = Cells(Target.Row, [HeadingsPL].Column + theMatch - 1).Value
                If Cells(2, iCol).Value > Pl Then
                     BL = Cells(Target.Row, [HeadingsBL].Column + theMatch).Value
                     Pl = Cells(Target.Row, [HeadingsPL].Column + theMatch).Value
                     x = Cells(Target.Row, [HeadingsNM].Column + theMatch).Value
                Else
                    BL = Cells(Target.Row, [HeadingsBL].Column + theMatch - 1).Value
                    x = Cells(Target.Row, [HeadingsNM].Column + theMatch - 1).Value
                End If
                If Cells(2, iCol).Value <= BL Or Cells(2, iCol).Value > Pl Then
                  Cells(Target.Row, iCol).Value = x
                ElseIf Cells(2, iCol).Value <= Pl And Pl > BL Then
                  Cells(Target.Row, iCol).Value = x & "-L"
                ElseIf IsError(theMatch) Then
                  Cells(Target.Row, iCol).Value = ""
                End If
            End If
        Next

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 



Sorry. In each of the assignments of x
Code:
x = Cells([b]1[/b], [HeadingsNM].Column + theMatch).Value
x = Cells([b]1[/b], [HeadingsNM].Column + theMatch - 1).Value


Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
thank you for ALLyour help.
I'll try to figure out why the Worksheet_Change isn't updating the cells.
 



If your program burped after the Application.EnableEvents = False then you have to enabble events. Execute this sub, then make a change on your sheet...
Code:
sub EnableOn()
  Application.EnableEvents = True
end sub
Don't give up!

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top