Solved

A quicker alternative to dLookup in vba code

Posted on 2004-09-02
10
1,654 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
 
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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

In the previous article, Using a Critera Form to Filter Records (http://www.experts-exchange.com/A_6069.html), the form was basically a data container storing user input, which queries and other database objects could read. The form had to remain op…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
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…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

746 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now