Easier / More Efficient Way

[jmcbay]

Is there an easier & more efficient way to write this code?

Private Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click


Dim CurrentRow As Integer
Dim ctlSource As Control
Dim CustID As Integer
Dim myRS As Recordset
Dim myDB As Database
Dim strSQL As String
Dim varCriteria As String
Dim TripID As Integer
Dim Ans As String

'******************************************************************************************************************
'******************************************************************************************************************
Set myDB = CurrentDb
Set ctlSource = Me!CustList
Set myRS = myDB.OpenRecordset("tTripCustomer")
TripID = Me!tcTID
Ans = ""

     For intCurrentRow = 1 To ctlSource.ListCount - 1
        If ctlSource.Selected(intCurrentRow) Then
            CustID = ctlSource.Column(0, intCurrentRow)
            varCriteria = "[tcCID]=" & CustID & " AND [tcTID]=" & TripID
            If myRS.RecordCount <= 0 Then
                MsgBox &quot;No Customers to Edit!&quot;
            Else
                myRS.FindFirst varCriteria
                
                
                'tcAmtDue
                If IsNull(Me!tcAmtDue) = False Then
                    If Me!tcAmtDue = 0 Then
                        Ans = MsgBox(&quot;Do you want to set the 'AMOUNT DUE' to $0.00?&quot;, vbYesNo, &quot;AMOUNT DUE&quot;)
                        If Ans = 6 Then
                            myRS.LockEdits = True
                            myRS.Edit
                            myRS(&quot;tcAmtDue&quot;) = 0
                            myRS.Update
                            myRS.LockEdits = False
                        End If
                        Ans = &quot;&quot;
                    Else
                        myRS.LockEdits = True
                        myRS.Edit
                        myRS(&quot;tcAmtDue&quot;) = Me!tcAmtDue
                        myRS.Update
                        myRS.LockEdits = False
                    End If
                End If
                
                'tcPytMethod
                If IsNull(Me!tcPytMethod) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcPytMethod&quot;) = Me!tcPytMethod
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcDepositAmt
                If IsNull(Me!tcDepositAmt) = False Then
                    If Me!tcDepositAmt = 0 Then
                        Ans = MsgBox(&quot;Do You want to set the 'DEPOSIT AMOUNT' to $0.00?&quot;, vbYesNo, &quot;DEPOSIT AMOUNT&quot;)
                        If Ans = 6 Then
                            myRS.LockEdits = True
                            myRS.Edit
                            myRS(&quot;tcDepositAmt&quot;) = 0
                            myRS.Update
                            myRS.LockEdits = False
                        End If
                        Ans = &quot;&quot;
                    Else
                        myRS.LockEdits = True
                        myRS.Edit
                        myRS(&quot;tcDepositAmt&quot;) = Me!tcDepositAmt
                        myRS.Update
                        myRS.LockEdits = False
                    End If
                End If
                
                'tcBrochure
                If IsNull(Me!tcBrochure) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcBrochure&quot;) = Me!tcBrochure
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcInvoice1
                If IsNull(Me!tcInvoice1) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcInvoice1&quot;) = Me!tcInvoice1
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcRelease
                If IsNull(Me!tcRelease) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcRelease&quot;) = Me!tcRelease
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcTravelIns
                If IsNull(Me!tcTravelIns) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcTravelIns&quot;) = Me!tcTravelIns
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcVisaApp
                If IsNull(Me!tcVisaApp) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcVisaApp&quot;) = Me!tcVisaApp
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcInvoiceF
                If IsNull(Me!tcInvoiceF) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcInvoiceF&quot;) = Me!tcInvoiceF
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcVouchers
                If IsNull(Me!tcVouchers) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcVouchers&quot;) = Me!tcVouchers
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcFlyShop
                If IsNull(Me!tcFlyShop) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcFlyShop&quot;) = Me!tcFlyShop
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcDepositRec
                If IsNull(Me!tcDepositRec) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcDepositRec&quot;) = Me!tcDepositRec
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcTrackNoDPyt
                If IsNull(Me!tcTrackNoDPyt) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcTrackNoDPyt&quot;) = Me!tcTrackNoDPyt
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcReleaseRec
                If IsNull(Me!tcReleaseRec) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcReleaseRec&quot;) = Me!tcReleaseRec
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcFinalPytRec
                If IsNull(Me!tcFinalPytRec) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcFinalPytRec&quot;) = Me!tcFinalPytRec
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
                'tcTrackNoFPyt
                If IsNull(Me!tcTrackNoFPyt) = False Then
                    myRS.LockEdits = True
                    myRS.Edit
                    myRS(&quot;tcTrackNoFPyt&quot;) = Me!tcTrackNoFPyt
                    myRS.Update
                    myRS.LockEdits = False
                End If
                
            End If
        End If
    Next intCurrentRow
     
     
'******************************************************************************************************************
'******************************************************************************************************************
 '  Close Form
    DoCmd.Close
    
 '  Close DB and RS; Set RS to Nothing
    myRS.Close
    myDB.Close
    Set myRS = Nothing
    
Exit_cmdClose_Click:
    Exit Sub

Err_cmdClose_Click:
    MsgBox Err.Description
    
    Resume Exit_cmdClose_Click
    
End Sub

 

[930driver]

A few comments:

It looks like your list box is set to multiselect. It would be more efficient to loop through the ItemsSelected collection rather than through the entire list.

Look up help on With/End With. It will allow you to set just one reference to myRS. As it stands right now VBA has to resolve the reference every time you are using it.

I would lock the record at the beginning and unlock it at the end of each update, rather than locking/unlocking for every field.

All of these will speed up your code.
"The Key, The Whole Key, and Nothing But The Key, So Help Me Codd!"

 

[MichaelRed]

Hmmmmmmmmmmmmmm,

I'm to old to read the whole thing in detail. I'd probably expire before finishing the reading - much less the critique. In general, it looks like a tortous approach to a few update queries. The possability of combinig many/most all of them by breaking this routine into a number of SMALL modules which accept the field (value) and return either the 'updated' or original value for the specific field could be interesting.

It is useful to not that it is almost impossible to write code (procedure) which will execute as quickly as the dbengine will for a given 'query', so the concept of generating the several queries is not just for ease of (programmer) reading, but a serious approach to improving the process.


MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[jmcbay]

Thanks for the help!

-- Jackie "Always Learning" McBay

 

[JimHorton]

Jackie,
As as starting point, here is an example onto which you can build and enhance.
First, adding to 930 drivers response, once you're in the 'found' block of the recordset (btw, don't use .count to see if the recordset is empty, check for .Eof AND .Bof), you open the recordset for editing:

Add the following Dims: i as Integer, strFld as String
blah, blah....
For intCurrentRow = 1 To ctlSource.ListCount - 1
If ctlSource.Selected(intCurrentRow) Then
CustID = ctlSource.Column(0, intCurrentRow)
varCriteria = "[tcCID]=" & CustID & " AND [tcTID]=" & TripID
If myRS.RecordCount <= 0 Then '<--Use IF myRS.Eof and MyRs.Bof here
MsgBox &quot;No Customers to Edit!&quot;
Else
myRS.FindFirst varCriteria
myRs.LockEdits = True
myRs.Edit 'Here open it for edit on any/all fields
'Now, instead of going by each field with an If/Else block, do the following
For i = 0 to Me.Controls.Count -1 'Rather than With/EndWith
'Let's say you're checking all TextBoxes in the Detail section
If TypeOf Me(i) is TextBox and me(i).Section = 0 Then
If not IsNull(me(i)) Then
strFld = me(i).name
myRS(strFld) = Me(i)
End If 'endif Not IsNull(me(i))
End If 'endif TypeOf me(i)...
Next i 'Next control

Myrs.Update 'now update
Myrs.LockEdits = false

NOW......................A few comments.....
Control naming is important, as you can see. The names must match in the Table and Form for this to match--If you base the Form on a Query with ALIAS's or duplicate names that must be fully qualified,( ie tTripCustomer.Name) then you'll have problems.

Also, for those fields with special treatment, ie Message Boxes, you'll have to 'IF' them out into their own block, which will cause some bloat but still much less than what was there; same goes for fields not meant to be included in this logic.

In addition, the code above might contain typo's, etc, but the general gist is there, it should help.
--Jim