Solved

A quicker alternative to dLookup in vba code

Posted on 2004-09-02
10
1,685 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
Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 
LVL 84

Accepted Solution

by:
Scott McDaniel (Microsoft Access MVP - EE MVE ) earned 250 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 84
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 84
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

Use Case: Protecting a Hybrid Cloud Infrastructure

Microsoft Azure is rapidly becoming the norm in dynamic IT environments. This document describes the challenges that organizations face when protecting data in a hybrid cloud IT environment and presents a use case to demonstrate how Acronis Backup protects all data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…

832 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