Speed this up for me, please

[Adrian D. Bailey]

Dear friends,
I have a series of sheets used as databases, and I have written functions to
help me retrieve info from them. These work just fine, but as my application
grows so it slows down, and I am aware that this code is not optimised for
speed. I'm not the world's best programmer, so help would be welcome. This
function (and several others very very similar) are at the heart of my
application, so small improvements here might have a wide ranging effect.

The rules of the database....
1. The first row of the sheet contains titles for the columns.
2. The order of the columns is not guaranteed.
3. I don't always look up using the same key - so any of the columns might
be the key. (Let me do the worrying about duplicate entries and uniqeness of
keys...)
4. There is no limit to the width or height of the sheet (other than the
usual 2^8 columns, 2^16 rows, and memory space)

To find the entry whose name is Smith and return the phone number a
worksheet would have the following formula in a cell...
=Sinfo("Name","Smith","Phone")

Function Sinfo(lookupkey, lookupval, rtnkey, Optional vol)
If IsMissing(vol) Then vol = False
Application.Volatile (vol)
On Error GoTo ErrHandler
Set rng = Workbooks("data.xls").Worksheets("students").Range("1:1")
lkcol = Application.WorksheetFunction.Match(lookupkey, rng, 0)
rtncol = Application.WorksheetFunction.Match(rtnkey, rng, 0)
With Workbooks("data.xls").Worksheets("students")
Set rng2 = .Range(.Cells(1, lkcol), .Cells(65535, lkcol))
End With
rtnrow = Application.WorksheetFunction.Match(lookupval, rng2, 0)
Sinfo = Workbooks("data.xls").Worksheets("students").Cells(rtnrow, rtncol)
Exit Function
ErrHandler:
Sinfo = "Not Found"
End Function

--
Adrian D.Bailey, Information and Systems Manager, Dept.Human Sciences
Loughborough University, Loughborough Leics, LE11 3TU, UK.
(e-mail address removed) Tel: 01509 223007 Fax: 01509 223940

Community Warden, Storer and Burleigh Areas. Out-of-hours Tel: 01509 563263
--

 

[Jim Cone]

Adrian,
I declared all of the variables, specified a default value for the optional
argument ,only used one range variable and eliminated the need for "With".
Whether it is faster is the question...

Function Sinfo_R1(ByRef lookupKey As String, ByRef lookupVal As String, _
ByRef rtnKey As String, Optional bVol As Boolean = False) As String
On Error GoTo ErrHandler
Dim rng As Excel.Range
Dim lkCol As Long
Dim rtnCol As Long
Dim rtnRow As Long

Application.Volatile (bVol)
Set rng = Workbooks("data.xls").Worksheets("students").UsedRange
lkCol = Application.Match(lookupKey, rng.Rows(1), 0) 'Lookup Name column
rtnCol = Application.Match(rtnKey, rng.Rows(1), 0) 'Lookup Phone column
rtnRow = Application.Match(lookupVal, rng.Columns(lkCol), 0)
Sinfo_R1 = rng(rtnRow, rtnCol).Value
Exit Function
ErrHandler:
Sinfo_R1 = "Not Found"
End Function

Sub FindIt()
MsgBox Sinfo_R1("Name", "Smith", "Phone")
End Sub
----------
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Adrian D. Bailey" <[email protected]>
wrote in message
Dear friends,
I have a series of sheets used as databases, and I have written functions to
help me retrieve info from them. These work just fine, but as my application
grows so it slows down, and I am aware that this code is not optimised for
speed. I'm not the world's best programmer, so help would be welcome. This
function (and several others very very similar) are at the heart of my
application, so small improvements here might have a wide ranging effect.

The rules of the database....
1. The first row of the sheet contains titles for the columns.
2. The order of the columns is not guaranteed.
3. I don't always look up using the same key - so any of the columns might
be the key. (Let me do the worrying about duplicate entries and uniqeness of
keys...)
4. There is no limit to the width or height of the sheet (other than the
usual 2^8 columns, 2^16 rows, and memory space)

To find the entry whose name is Smith and return the phone number a
worksheet would have the following formula in a cell...
=Sinfo("Name","Smith","Phone")

Function Sinfo(lookupkey, lookupval, rtnkey, Optional vol)
If IsMissing(vol) Then vol = False
Application.Volatile (vol)
On Error GoTo ErrHandler
Set rng = Workbooks("data.xls").Worksheets("students").Range("1:1")
lkcol = Application.WorksheetFunction.Match(lookupkey, rng, 0)
rtncol = Application.WorksheetFunction.Match(rtnkey, rng, 0)
With Workbooks("data.xls").Worksheets("students")
Set rng2 = .Range(.Cells(1, lkcol), .Cells(65535, lkcol))
End With
rtnrow = Application.WorksheetFunction.Match(lookupval, rng2, 0)
Sinfo = Workbooks("data.xls").Worksheets("students").Cells(rtnrow, rtncol)
Exit Function
ErrHandler:
Sinfo = "Not Found"
End Function
--
Adrian D.Bailey, Information and Systems Manager, Dept.Human Sciences
Loughborough University, Loughborough Leics, LE11 3TU, UK.
(e-mail address removed) Tel: 01509 223007 Fax: 01509 223940
Community Warden, Storer and Burleigh Areas. Out-of-hours Tel: 01509 563263
--