Improve company productivity with a Business Account.Sign Up

x
?
Solved

A quicker alternative to dLookup in vba code

Posted on 2004-09-02
10
Medium Priority
?
1,897 Views
Last Modified: 2008-09-01
Hi I have some code in vba that uses the dLookUp function a lot. This is fine on smaller result sets but now, I am finding myself with considerably larger result sets, it is taking a long time to execute. Can anyone suggest an alternative that would do the same job but a lot quicker. Here is a sample of code...


        jobID = DLookup("[" & sqjbID & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        pagecount = DLookup("[" & sqpagecount & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        quantity = DLookup("[" & sqQuantity & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        Client = DLookup("[" & sqClient & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        size = DLookup("[" & sqSize & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        hardback = DLookup("[" & sqHardback & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        lamination = DLookup("[" & sqLamination & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        lamType = Nz(DLookup("[" & sqLamType & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid))
        PPC = Nz(DLookup("[" & sqPPC & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid))
       

Basically I am tring to get a load of values out of a query in the vba code to perform calculation  - this is a row numbered view not a stored procedure. This runs in a for loop until it reaches the last record of the query. There must be a better way of doing this, I'm just not sure what direction to head in. I am dealing with record sets of about 300.

Thanks in advance.

Steph
0
Comment
Question by:Steffee
  • 4
  • 3
  • 3
10 Comments
 
LVL 4

Expert Comment

by:Colonel32
ID: 11962014
The usual approach is to use a recorset to capture the query result set, then cycle through that object in memory. Is there a reason you haven't used this or would you just like a demonstration?
:)
0
 

Author Comment

by:Steffee
ID: 11962042
To be honest, I haven't had much experience with using recordsets in vba, and this was an option that seemed feasible - works fine for small numbers but the system is really struggling now. So yes a demonstration  of how to cycle through the object would be great - if you would be kind enough to help.

Thanks

Steph
0
 
LVL 4

Expert Comment

by:Colonel32
ID: 11962109
No probs, could you explain how you currently use your variables "selectquery", "row" and "firstid" please? Since you mentioned this is contained in a loop, it might be usefull to see the whole piece of related code first :)
0
Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

 
LVL 86

Accepted Solution

by:
Scott McDaniel (Microsoft Access MVP - EE MVE ) earned 750 total points
ID: 11962170
You can open your recordset like this:

Dim rst As DAO.Recordset

Set rst = Currentdb.OpenRecordset("SELECT * FROM " & selectquery & " WHERE [" & row & "]=" & firstid)

If rst.RecordCount > 0 Then
  jobID= rst.Fields(sqjbID)
  pagecount = rst.Fields(sqpagecount)
  etc etc
End IF

This would return 1 row ... as Colonel32 said, if you wish to loop through one or more records, you may be able to more easily with a WHERE clause or some other filteriing technique ... also, what's the purpose of the variables in the fields in the dcount  (i.e. DLookup("[" & sqjbID & "]", "[" & .... what is sqjbID and where do you get this?)
0
 

Author Comment

by:Steffee
ID: 11962246
Ok, here's my large piece of code, it is not super quick or slick by any means - but it does do the job...so please feel free to constructively criticise it!

It's quite long so I have omitted all the dim statements and body of most of the case statements to save on space:

sqjbID = "jbID"
sqpagecount = "bkPagecount"
sqQuantity = "jbQuantity"
sqClient = "bkClient"
sqSize = "Trim"
sqHardback = "bkHardback"
sqLamination = "bkLamination"
sqLamType = "bkLamType"
sqPPC = "PPC"


row = "itbrownum"
selectquery = "vwItemsToBillNum"
recordcount = DCount("[" & row & "]", "[" & selectquery & "]")

If recordcount > 0 Then
'obtain range of query to loop through
firstid = DMin("[" & row & "]", "[" & selectquery & "]")
lastid = DMax("[" & row & "]", "[" & selectquery & "]")




'Loop through each record in query
    For firstid = DMin("[" & row & "]", "[" & selectquery & "]") To lastid
   
        'determine variables that are needed to obtain unit cost of book.

        jobID = DLookup("[" & sqjbID & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        pagecount = DLookup("[" & sqpagecount & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        quantity = DLookup("[" & sqQuantity & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        Client = DLookup("[" & sqClient & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        size = DLookup("[" & sqSize & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        hardback = DLookup("[" & sqHardback & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        lamination = DLookup("[" & sqLamination & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid)
        lamType = Nz(DLookup("[" & sqLamType & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid))
        PPC = Nz(DLookup("[" & sqPPC & "]", "[" & selectquery & "]", "[" & row & "]= " & firstid))
       
       
        'determine client so to use correct record in tblBill to get figures from
   
        Select Case Client

            Case "abc"
              etc...
            Case Else
            MsgBox "Unrecognised Client - please check"
           
        End Select
       
        'use quantity to obtain header of applicable discount column
       
        Select Case quantity
       
            Case 21 To 40
                percentDiscount = "bi20plusPercent"
           
               etc...
        End Select
       
       ' following code determines columns to use in tblBill depending on size of book and paper/hardback
       ' only applies to those books which have a pagecount less than 400 - 400 + follow other rules
     
        If pagecount > 400 Then pages = True Else pages = False
         size = Left(size, 3)
         
        If size > 240 And hardback = False Then
        biInitialRATE = "biInitialRateLgPap"
        biTwoPageCost = "biIncrement2ppLgPap"
        biInitialPages = "biPagesLgPap"
       
        ElseIf size < 240 And hardback = False Then
        biInitialRATE = "biInitialRateSmPap"
        biTwoPageCost = "biIncrement2ppSmPap"
        biInitialPages = "biPagesSmPap"
       
        ElseIf size > 240 And hardback = True Then
        biInitialRATE = "biInitialRateLgHard"
        biTwoPageCost = "biIncrement2ppLgHard"
        biInitialPages = "biPagesLgHard"
       
        ElseIf size < 240 And hardback = True Then
        biInitialRATE = "biInitialRateSmHard"
        biTwoPageCost = "biIncrement2ppSmHard"
        biInitialPages = "biPagesSmHard"
       
        End If
       
   
        'formaula to calculate unit cost of books less than 401 pages
        'uses perce
        If pages = False Then
            size = Left(size, 3)
            initialrate = DLookup("[" & biInitialRATE & "]", "tblBill", "biid = " & clientcode)
            twopagecost = DLookup("[" & biTwoPageCost & "]", "tblBill", "biid = " & clientcode)
            initialPages = DLookup("[" & biInitialPages & "]", "tblBill", "biid = " & clientcode)
            numberOfIncrements = (pagecount - initialPages) / 2
            percenttomultiplyby = numberOfIncrements * twopagecost
            'percenttomultiplyby = percenttomultiplyby
           
            unitcost = percenttomultiplyby + initialrate
           

                    If quantity > 20 Then
                        unitcostmultiplier = DLookup("[" & percentDiscount & "]", "tblBill", "biid = " & clientcode)
                     unitcost = unitcost * unitcostmultiplier
                     End If
                   
            'unitcost = unitcost
       
       
        Else 'if pagecount > 400
       
        '****************** for books with pagecount of 401 or more *********************************************
       
            extrapagestochargefor = pagecount - 400
            extrapagestochargefor = extrapagestochargefor / 16
           
            extrapagestochargefor = RoundNear(extrapagestochargefor, 1)
                   
                If size > 240 And hardback = False Then
                        biInitialRATE = "bi400RateLgFormatPap"
                        bi16ppCost = "biPricePer16pageslgFormatPap"
                   
                    ElseIf size < 240 And hardback = False Then
                        biInitialRATE = "bi400RatesmFormatPap"
                        bi16ppCost = "biPricePer16pagessmFormatPap"
                   
                    ElseIf size > 240 And hardback = True Then
                        biInitialRATE = "bi400RateLgFormatHard"
                        bi16ppCost = "biPricePer16pageslgFormatHard"
                   
                    ElseIf size < 240 And hardback = True Then
                        biInitialRATE = "bi400RatesmFormatHard"
                        bi16ppCost = "biPricePer16pagessmFormatHard"
                 
                  End If
               
        bi400PageInitialRate = DLookup("[" & biInitialRATE & "]", "tblBill", "biID = " & clientcode)
       
        bi400Page16ppcost = DLookup("[" & bi16ppCost & "]", "tblBill", "biID = " & clientcode)
        unitcost = bi400PageInitialRate + (extrapagestochargefor * bi400Page16ppcost)
       
        End If
       
        '*********************** To obtain Lamination charge dependent on type ********************************
        If hardback = False Then
       
        Select Case lamType
       
         Case 1
         unitcost = unitcost
         Case 2
          etc...        
         MsgBox "Lamination Type not recognised - please check"
         
         End Select
         End If
         
         
         '************** To obtain hardback cost if supplementary on top of schedule *********************
         
         If hardback = True Then
            If PPC = False Then
                bihardbackSchedUnitCostOnly = DLookup("bihardbackSchedUnitCostOnly", "tblBill", "biID = " & clientcode)
               
                If bihardbackSchedUnitCostOnly = True Then
                    unitcost = unitcost
                Else
               
                    Select Case quantity
                        Case Is < 10
                            hardbackquantity = "biBuckramLess10"
                        etc...
                    End Select
                   
                    bihardbackcost = DLookup("[" & hardbackquantity & "]", "tblBill", "biID = " & clientcode)
                    unitcost = unitcost + bihardbackcost
                End If
           
            Else
            '******************************* TO DETERMINE PPC COST ***************************************
            If biPPCSchedUnitCostOnly = True Then
                unitcost = unitcost
            Else
           
             Select Case quantity
                        Case Is < 10
                             PPCquantity = "biPPCLess10"
                      etc
                    End Select
                   
                biPPCcost = DLookup("[" & PPCquantity & "]", "tblBill", "biID = " & clientcode)
                unitcost = unitcost + biPPCcost
            End If
        End If
    End If
       
               
           
        DoCmd.RunSQL "update tblJob set jbUnitCost = " & unitcost & " ,jbPriceCreatedWhen = '" & Format(Date, "dd-mmm-yyyy") & "' where jbID = " & jobID
       
        Next
             
End If

End Sub


0
 
LVL 4

Expert Comment

by:Colonel32
ID: 11962947
LSM demonstrated exactly what I was going to suggest, are you able to see how to implement that within your code?
0
 

Author Comment

by:Steffee
ID: 11963535
I'm just having a go with a recordset, should be able to work it out, but I am getting the following error:

Object variable or with block not set...

Here is the code, very short piece as I'm just testing:

sqjbID = "jbID"
sqpagecount = "bkPagecount"
sqQuantity = "jbQuantity"
sqClient = "bkClient"
sqSize = "Trim"
sqHardback = "bkHardback"
sqLamination = "bkLamination"
sqLamType = "bkLamType"
sqPPC = "PPC"


row = "itbrownum"
selectquery = "vwItemsToBillNum"



Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT TOP 100 PERCENT(SELECT COUNT(*) " & _
     " FROM vwItemsToBill AS D2" & _
     " WHERE D2.jbID < D1.jbid) + 1 AS itbrownum, * " & _
" FROM vwItemsToBill AS D1 " & _
" ORDER BY itbrownum")

If rst.recordcount > 0 Then
Do While Not rst.EOF

    jobID = rst.Fields("[" & sqjbID & "]")
    pagecount = rst.Fields("[" & sqpagecount & "]")
    quantity = rst.Fields("[" & sqQuantity & "]")
    Client = rst.Fields("[" & sqClient & "]")
    size = rst.Fields("[" & sqSize & "]")
    hardback = rst.Fields("[" & sqHardback & "]")
    lamination = rst.Fields("[" & sqLamination & "]")
    lamType = rst.Fields("[" & sqLamType & "]")
    PPC = rst.Fields("[" & sqPPC & "]")
       
   
rst.MoveNext
Loop
     
     rst.close  
             
End If

End Sub

Any ideas why I am getting this error?

Thanks for your help so far.

Steph
0
 
LVL 86
ID: 11963624
Where are you getting this error? Which line?
0
 

Author Comment

by:Steffee
ID: 11963887
on the set rst = currentdb.openrecordset "....."
0
 
LVL 86
ID: 11964979
Make sure you have a reference to the Microsoft DAO Object Library xx (where xx is the highest number you see) ... I've also seen odd error like this occur when I've been coding for a long time and haven't restarted my machine ... I've gotten into the habit of doing this a couple times a day.
0

Featured Post

Easily Design & Build Your Next Website

Squarespace’s all-in-one platform gives you everything you need to express yourself creatively online, whether it is with a domain, website, or online store. Get started with your free trial today, and when ready, take 10% off your first purchase with offer code 'EXPERTS'.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
A Case Study of using the Windows API to provide RS232 communications capability in Access without the use of Active-X controls.
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

608 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question