Optimize Recordset update - speed

[grahamjlaws]

Hi, how can i best optimize this code for speed?

Private Sub cmdBOM_Click()
Dim blnOK As Boolean
If Me.LMsuccess = "No" Then
MsgBox "Please Import LM data before processing", vbInformation, "Processing BOMs"
Else
MsgBox ("Files Found")
'in Tools | References, make sure the ADO ' "Microsoft ActiveX Data Objects 2.1 Library" is checked
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim strPCode As String
Dim lngRecNo As Long
Dim lngRecCount As Long
Call acbInitMeter("BOM Manipulation", True)
lngRecCount = DCount("*", "tbom")
strSQL = "Select * From tbom"
Set rst = New ADODB.Recordset
rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, _
adLockOptimistic, adCmdText
If Not rst.BOF And Not rst.EOF Then
'Initialize variables
strPCode = rst.Fields("pCode").Value
rst.MoveNext
Else
MsgBox "There are NO records in the recordset!", _
vbCritical, "No records Found!"
rst.Close
Set rst = Nothing
Exit Sub
End If
lngRecNo = 0
Do While Not rst.EOF
DoEvents
blnOK = acbUpdateMeter((lngRecNo / lngRecCount) * 100)
If Not blnOK Then
With Me
.BPsuccess = "No"
.BPdate = ""
End With
Call acbCloseMeter
rst.Close
Set rst = Nothing
'MsgBox "Operation Cancelled!", vbOKOnly + vbCritical, "Process BOMs"
Exit Sub
End If
If rst.Fields("pCode").Value = "." Then
rst.Fields("pCode").Value = strPCode
rst.Update
Else
strPCode = rst.Fields("pCode").Value
End If
'Move to the next record
lngRecNo = lngRecNo + 1
rst.MoveNext
Loop

rst.Close
Set rst = Nothing
Call acbCloseMeter

DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT pCode, Bqty, bUnit " & _
"INTO tBuildUnit " & _
"FROM tBom " & _
"WHERE (((tBom.cCode) Is Null));"
DoCmd.SetWarnings True

MsgBox ("BOM processing completed successfully")

With Me
.BPsuccess = "Yes"
.BPdate = Now()
End With
End If
End Sub


Thanks,

Graham

 

[MarkK]

Optimize the chance someone will work through your code
  1) Wrap it in code tags.  
      a) Highlight text and hit the number sign.  
  2) This preserves indents and uses a non-PS font.  
      a) This'll make it much easier for people to help.
Cheers,

 

[KernelK]

I feel generous today. Here is his code, formatted properly (well better than it was) for anyone who wishes to help this individual. After cleaning it, I didn't feel like analyzing it.

Private Sub cmdBOM_Click()
    Dim blnOK As Boolean
    
    If Me.LMsuccess = "No" Then
        MsgBox "Please Import LM data before processing", vbInformation, "Processing BOMs"
    Else
        MsgBox ("Files Found")
        'in Tools | References, make sure the ADO ' "Microsoft ActiveX Data Objects 2.1 Library" is checked

        Dim rst As ADODB.Recordset
        Dim strSQL As String
        Dim strPCode As String
        Dim lngRecNo As Long
        Dim lngRecCount As Long
        
        Call acbInitMeter("BOM Manipulation", True)
        lngRecCount = DCount("*", "tbom")
        strSQL = "Select * From tbom"
        Set rst = New ADODB.Recordset
    
        rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText
        If Not rst.BOF And Not rst.EOF Then
            'Initialize variables
            strPCode = rst.Fields("pCode").Value
            rst.MoveNext
        Else
            MsgBox "There are NO records in the recordset!", vbCritical, "No records Found!"
            rst.Close
            Set rst = Nothing
            Exit Sub
        End If
        
        lngRecNo = 0
        Do While Not rst.EOF
            DoEvents
            blnOK = acbUpdateMeter((lngRecNo / lngRecCount) * 100)
            If Not blnOK Then
                With Me
                    .BPsuccess = "No"
                    .BPdate = ""
                End With
                
                Call acbCloseMeter
                rst.Close
    
                Set rst = Nothing
                'MsgBox "Operation Cancelled!", vbOKOnly + vbCritical, "Process BOMs"
                Exit Sub
            End If
    
            If rst.Fields("pCode").Value = "." Then
                rst.Fields("pCode").Value = strPCode
                rst.Update
            Else
                strPCode = rst.Fields("pCode").Value
            End If
    
            'Move to the next record
            lngRecNo = lngRecNo + 1
            rst.MoveNext
        Loop
    
        rst.Close
        Set rst = Nothing
        Call acbCloseMeter
    
        DoCmd.SetWarnings False
        DoCmd.RunSQL "SELECT pCode, Bqty, bUnit " & "INTO tBuildUnit " & "FROM tBom " & "WHERE (((tBom.cCode) Is Null));"
        DoCmd.SetWarnings True
    
        MsgBox ("BOM processing completed successfully")
    
        With Me
            .BPsuccess = "Yes"
            .BPdate = Now()
        End With
    End If
End Sub

 

[Moniker]

Cleaned up code:

Private Sub cmdBOM_Click()

    'in Tools | References, make sure the ADO ' "Microsoft ActiveX Data Objects 2.1 Library" is checked
    
    Dim blnOK As Boolean	
    Dim rst As ADODB.Recordset [COLOR="Red"]<--- Declare all variables at the top[/COLOR]
    Dim strSQL As String
    Dim strPCode As String
    Dim lngRecNo As Long
    Dim lngRecCount As Long

    If Me.LMsuccess = "No" Then
        MsgBox "Please Import LM data before processing", vbInformation, "Processing BOMs"
        Exit Sub    [COLOR="Red"]<--- Ends the huge nested IF..Then Statement[/COLOR]
    End If

    MsgBox ("Files Found")
    
    Call acbInitMeter("BOM Manipulation", True) [COLOR="Red"]<--- Don't know what this is[/COLOR]
    lngRecCount = DCount("*", "tbom")
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tbom", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText 
              [COLOR="Red"]^^ No need to put tiny SQL statements into a variable[/COLOR]
    If Not rst.BOF And Not rst.EOF Then
        'Initialize variables
        strPCode = rst.Fields("pCode").Value
        rst.MoveNext
        [COLOR="Red"]^^ What are you doing here?  Unless the table tbom contains one record, there's
        no way to tell what you are assigning strPCode to.[/COLOR]    
    Else
        MsgBox "There are NO records in the recordset!", vbCritical, "No records Found!"
        rst.Close
        Set rst = Nothing
        Exit Sub
    End If

    lngRecNo = 0
    Do While Not rst.EOF
        DoEvents [COLOR="Red"]<--- Why is this here?  This is telling Windows to do everything else before
                 continuing with your program.[/COLOR]
        blnOK = acbUpdateMeter((lngRecNo / lngRecCount) * 100)
        If Not blnOK Then
            With Me
                .BPsuccess = "No"
                .BPdate = ""
            End With
            Call acbCloseMeter
            rst.Close
            Set rst = Nothing
	    Exit Sub
        End If
    
        If rst.Fields("pCode").Value = "." Then
            rst.Fields("pCode").Value = strPCode
            rst.Update
        Else
            strPCode = rst.Fields("pCode").Value
        End If
        lngRecNo = lngRecNo + 1
        rst.MoveNext
    Loop

    rst.Close
    Set rst = Nothing
    Call acbCloseMeter

    CurrentDb.Execute "SELECT pCode, Bqty, bUnit INTO tBuildUnit FROM tBom WHERE (((tBom.cCode) Is Null));"
    [COLOR="Red"]^^ CurrentDb.Execute does the same thing as DoCmd.SetWarnings Off, DoCmd.RunSQL, DoCmd.SetWarnings On[/COLOR]

    MsgBox ("BOM processing completed successfully")

    With Me
        .BPsuccess = "Yes"
        .BPdate = Now()
    End With

End Sub

Honestly, it just looks like you're trying to update a table through code instead of an UPDATE query, which would be 100 times if not more faster. You may have a few qualifiers you need straightened out before running the query, but I'm not seeing anything different that this code is doing besides a fairly straightforward UPDATE.

 

[grahamjlaws]

Hi Moniker,

Thank you for the post, and apologies for not formatting correctly, I didn't know how to do that, I'm new to both Access and this site.



I also posted on EE and ended up with the following which I think is what you are suggesting:

In Module:

Dim OldVal As String


Function FillField(strCode As String) As String
If strCode <> "." Then
FillField = strCode
Else
FillField = OldVal
End If
OldVal = FillField
End Function

Then on my form:

CurrentDb.Execute "UPDATE tBom SET tBom.pCode = fillfield([pcode]);"

Like you say it took 2-3 sec instead of 100+ seconds

The acbinitMeter was a progress meter because ADO method (with my unecessary 'Do Events') was taking so long, and i wanted the user to know what was going on.

But with the update statement it is so fast no progress is required.

Thanks for your help. and sorry again about the formatting.

Regards

Graham

 

[Moniker]

No problem. Glad it pointed you in the right direction.