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 biv343 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
Aug 31, 2005
134
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.
 
Oops - sorry for suggesting that - just trying to be helpful.

Einstein47 (Starbase47.com)
“Never put both feet in your mouth at the same time.
Because then you won't have a leg to stand on.“

- Unknown
 
Skip,

Are you saying I should do a for...next in my function?
This is taking the same amount of time. Am I missing something?

Code:
Function LM4(RefDate, Namerng As Range, BLrng As Range, Plrng As Range)

y = 0

matchrefdate = Application.Match(RefDate, BLrng, 1)

For Each BLcell In BLrng
    y = y + 1
    If y = matchrefdate Then Exit For
Next BLcell
y = 0

For Each Plcell In Plrng
    y = y + 1
    If y = matchrefdate Then Exit For
Next Plcell

If RefDate > Plcell.Value Then
y = 0

For Each BLcell In BLrng
    y = y + 1
    If y = matchrefdate + 1 Then Exit For
Next BLcell

y = 0

For Each Plcell In Plrng
    y = y + 1
    If y = matchrefdate + 1 Then Exit For
Next Plcell
End If 

If RefDate <= BLcell.Value Or RefDate > Plcell.Value Then

LM4 = Application.Index(Namerng, 1, y).Value

ElseIf RefDate <= Plcell.Value And Plcell.Value > BLcell.Value Then
LM4 = Application.Index(Namerng, 1, y).Value & "-L"
ElseIf RefDate > Plcell.Value And RefDate > BLcell.Value Then
LM4 = ""
End If
End Function
 




Not in your function. In a SUB instead, that would loop thru ALL the rows and columns specified.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
sorry that I'm bother you. But I'm a little confused. Are you stating that I should do a sub instead of a function? I'm just trying to make it where if the customer adds the dates that it will give them the data (Step 2 or if it's late) without them having to run a sub. Is there a way to have both the sub and function?
 



You could make a sub fire using the Worksheet_Change event, when all the entries are present in a row. It would populate ONLY the AI to IV data in that row.

Skip,

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


Here's code that I ran sucessfully. You must...

name the BL heading range HeadingsBL
name the PL heading range HeadingsPL
name the Name heading range HeadingsNM
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'this procedure fills in the data in columns AI to IV
    Dim r As Range, bDone As Boolean
    bDone = True
    'check to see if all the source row data is entered
    For Each r In Union([HeadingsBL], [HeadingsPL], [HeadingsNM])
        If Cells(Target.Row, r.Column).Value = 0 Then bDone = False
    Next
    If bDone Then
    'turn off event processing and fill in data
        Application.EnableEvents = False
        For iCol = Cells(1, "AI").Column To Cells(1, "IV").Column
            theMatch = Application.Match( _
                CLng(Cells(1, iCol).Value), _
                Intersect(Target.EntireRow, [HeadingsBL].EntireColumn), 1)
            pl = Cells(Target.Row, [HeadingsPL].Column + theMatch - 1).Value
            If Cells(1, 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(1, iCol).Value <= BL Or Cells(1, iCol).Value > pl Then
              Cells(Target.Row, iCol).Value = x
            ElseIf Cells(1, iCol).Value <= pl And pl > BL Then
              Cells(Target.Row, iCol).Value = x & "-L"
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
Paste this code in the SHEET OBJECT CODE WINDOW, for the sheet containing your data.



Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
I'm not familiar with Worksheet_Change event and didn't see anything that could help me in the Tek-tips. Is there a place where I can look this up?
 
sorry didn't see your post when I was writing this. I need to remember to refresh the web page before I post
 
ok. I've looked through this and put in the SHEET OBJECT CODE WINDOW, but I"m not understanding the HeadingsBL, Headings PL, and HeadingsNM. I put a name range in the worksheet for the appropriate ranges, but I didn't see any changes. I apologize for bugging, but I really just don't understand how the Worksheet_Change works.
 


1. Remove your function formulas from the sheet.

2. Edit any CELL in the BL, PL or Late Act. (Name) column.

3. Observe the results.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
that's just it. I don't see anything. That's why I think I did my Headings incorrectly. I put in name ranges for the headings in the worksheet (thought that's what you meant on:
name the BL heading range HeadingsBL
name the PL heading range HeadingsPL
name the Name heading range HeadingsNM
 



So, in the Name Box, when you select HeadingsBL, what cells are selected?

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
HeadingsBL=$G$2:$K$5000
HeadingsPL=$L$2:$P$5000
HeadingsNM=$G$1:$K$1
 


The key word is Headings

Assumption: Headings are in ROW ONE.
[tt]
HeadingsBL=$G$1:$K$1
HeadingsPL=$L$1:$P$1
HeadingsNM=$G$1:$K$1
[/tt]
So you have FIVE columns of BL dates??? G:K
So you have FIVE columns if PL dates??? L:p
So you have the SAME FIVE columns of NAME data???

I don't think so!!!

Please describe you column layout to me. Your descriptions up to this point have been very cryptic.

Does you table start in column A?

What columns are the BL columns?

What columns are the PL columns?

Which COLUMN has Late Act.?

What column does the FIRST Ref Date occur in?

I believe I have made some inaccurate assumptions.

Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
Does you table start in column A-F? Yes, but that data isn't looked at for the formula

What columns are the BL columns? G-K

What columns are the PL columns? L-P

Which COLUMN has Late Act.? R

What column does the FIRST Ref Date occur in? S-IV

Again, I'm sorry for the confusion.
 




Then...
[tt]
HeadingsBL=$G$1:$K$1
HeadingsPL=$L$1:$P$1
HeadingsNM=$R$1
[/tt]
and in the code...
Code:
        For iCol = Cells(1, "S").Column To Cells(1, "IV").Column



Skip,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
so I've input the following values in the code:
Code:
HeadingsBL=Range("$G$2:$K$2").address
HeadingsPL=Range("$L$2:$P$2").address
HeadingsNM=Range("$G$1:$K$1").address
then changed (in [b]bold[/b] this is the ONLY thing I changed in your code) 
For Each r in Union ([b]Range([/b]HeadingsBL),([b]Range([/b]HeadingsPL),
([b]Range([/b]HeadingsNM)

but then I have an "Object required" error when it gets to thematch
Code:
theMatch = Application.Match( _
                CLng(Cells(1, iCol).Value), _
                Intersect(Target.EntireRow, [HeadingsBL].EntireColumn), 1)

again thanks for your help and patience
 
So, you don't know what a named range is ?
Select G2:K2
menu Insert -> Name -> Define ...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
ok. Thanks. I misunderstood Skip. I've define the ranges, but I'm still having trouble with the code. It either doesn't update the cells or it still gives me object define error. I'll try to find out how the "Worksheet_Change" works to see if I'm screwing something up. Thanks again for your help.
 




Check out Excel HELP on About labels and names in formulas

Aghhhhhh!!!!!!

I'm sorry if my post above lead you to believe that a named range gets assigned in code.

You posted...
Code:
HeadingsBL=Range("$G$2:$K$2").address
HeadingsPL=Range("$L$2:$P$2").address
HeadingsNM=Range("$G$1:$K$1").address
First of all NO CODE to make named ranges!!!

Second, We are talking about HEADINGS. You have BOTH row 2 and row 1 in the above example of your intentions.

WHICH IS IT??? What ROW are your headings in??? As I previously posted...
The key word is Headings

Assumption: Headings are in ROW ONE.
[/code]
and you neither VERIFIED nor CORRECTED this statement!


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