Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

A quicker alternative to dLookup in vba code

Posted on 2004-09-02
10
Medium Priority
?
1,785 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 
LVL 85

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 85
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 85
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

NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

Question has a verified solution.

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

This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

721 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