• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1868
  • Last Modified:

A quicker alternative to dLookup in vba code

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
Steffee
Asked:
Steffee
  • 4
  • 3
  • 3
1 Solution
 
Colonel32Commented:
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
 
SteffeeAuthor Commented:
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
 
Colonel32Commented:
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
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
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
 
SteffeeAuthor Commented:
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
 
Colonel32Commented:
LSM demonstrated exactly what I was going to suggest, are you able to see how to implement that within your code?
0
 
SteffeeAuthor Commented:
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
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Where are you getting this error? Which line?
0
 
SteffeeAuthor Commented:
on the set rst = currentdb.openrecordset "....."
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
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

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 4
  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now