Solved

VBA Function Hangs when Run Automatically - Fine when Manually Stepped Through

Posted on 2011-09-29
17
382 Views
Last Modified: 2012-05-12
Hello Experts,

I have a class method that is fairly long and does a handful of complex calculations while looping through multiple recordsets and updating/adding records where needed.

The problem I am having is when it is run from a form access gives a "not responding" message and the software hangs - no matter how long I let it process.

(I have the statusbar updated after each loop iteration. There are typically 4,000+ records it is looping through and the statusbar stops updating after record 50-60, this is then when the screen goes semi-opaque and reports not responding. Even if I let Access sit and process for several more minutes the process never completes)

However, if I put a break in the method and step through one of the loops for a few iterations (10 or so) and then press shift+f8 for it to automatically run/complete, the method completes without a problem.

To me this indicates that the method's code works fine and there is not a problem there. However, it seems that it is pretty resource intensive and will most definitely take a minute or two to complete and this seems to cause access to hang.

Is there a line of code/function I can add to the method that lets access know "prepare yourself...this will take a while", or something I can do for this method to complete without hanging. It needs to run automatically, I cannot expect the user to step through the code manually.

I have tried DoEvents, however this has not improved anything.

Not sure if it helps, but here is the method itself:
 
'============================================
Public Function DataChangesMade() As Boolean
'============================================
'Purpose: Compare Products in latest data download with what is currently in main product database
'Requires: Data matching between main product table and current vendor table
'Returns: True if data was correctly updated

On Error GoTo HandleErr
    
DataChangesMade = False

Dim rsProductList As DAO.Recordset
Dim rsProductID As DAO.Recordset
Dim strSQLOrig As String
Dim strSQLFilter As String
Dim strSQL2 As String
Dim strCriteria As String

Dim intCounter As Integer
Dim a As Integer
Dim intTotalColumns As Integer
Dim OldValue As Variant
Dim NewValue As Variant
Dim arrProducts() As Variant
Dim oProduct As cProducts
Set oProduct = New cProducts

'time testing
gOTimer.StartCounter

StatusBar "Updating Product Information..."

intCounter = 0
DoEvents
'###################################
'Dynamically Create Union Query of all products in tmp table and main product table
'#################################
strSQLOrig = VendorMainProductList
If strSQLOrig = "" Then 'the product total list is empty
    GoTo Done 'need to exit
Else
    'Get list of vendors products with equivalent TTechID
    strSQL2 = "SELECT A.TTechID" & _
              " FROM " & Me.strVSourceTable & " A" & _
              " WHERE A.TTechID IS NOT NULL"

    Set rsProductID = CurrentDb.OpenRecordset(strSQL2)

    If rsProductID.RecordCount <> 0 Then 'start looping through
        rsProductID.MoveLast
        rsProductID.MoveFirst

        Do While Not rsProductID.EOF
            'intID = rsProductID!TTechID
            
            'Set recordset to the list of mainproduct data and vendorproduct data
            'Set rsProductList = CurrentDb.OpenRecordset(strSQL)

            StatusBar "Updating ProductID: " & rsProductID!TTechID & " (" & intCounter & " of " & rsProductID.RecordCount & ")"
            
            'Filter recordset for only the current product
            strSQLFilter = strSQLOrig & " HAVING tmp.TTechID = " & rsProductID!TTechID
                StatusBar "Updating ProductID: " & rsProductID!TTechID & " (" & intCounter & " of " & rsProductID.RecordCount & ") -  Opening Recordset"
            Set rsProductList = CurrentDb.OpenRecordset(strSQLFilter)
                StatusBar "Updating ProductID: " & rsProductID!TTechID & " (" & intCounter & " of " & rsProductID.RecordCount & ") -  Recordset Done"
            If rsProductList.RecordCount <> 0 Then 'Make sure recordset isn't empty
                'Move through entire recordset to get correct record count
                rsProductList.MoveLast
                rsProductList.MoveFirst
                
                
            '    strCriteria = "[TTechID] = " & rsProductID!TTechID
             '   rsProductList.FindFirst strCriteria
                
                If rsProductList.RecordCount > 1 Then 'Make sure that there are more then one records, b/c there should be 2 one from the old table and one from the new table
                    'Set product object to current product record
                    oProduct.ProductID = rsProductID!TTechID
                    'Debug.Print rsProductID!TTechID
                    
                    'Set total number of columns in recordset
                    '      For somereason it starts counting from 1 and not 0
                    intTotalColumns = rsProductList.Fields.Count - 1
                    
                    'Redim the array to the total columns of recordset
                    ReDim arrProducts(0 To 1, 2 To intTotalColumns)
                    
                    'Need to do this for each column in recordset
                    'Need to skip column 1 and 2 i.e. table name and ttechid
                    'rsproductlist.field(0) = tablename
                    'rsproductlist.field(1) = ttechid
                    'need to start at 2
                    StatusBar "Updating ProductID: " & rsProductID!TTechID & " (" & intCounter & " of " & rsProductID.RecordCount & ") -  Updating Array"
                    For a = 2 To intTotalColumns
                        
                        'Fill array with old and new product values
                        Do Until rsProductList.EOF
                            If rsProductList!SourceTable = scMainTable Then
                                arrProducts(0, a) = rsProductList.Fields(a)
                            Else
                                arrProducts(1, a) = rsProductList.Fields(a)
                            End If
                            rsProductList.MoveNext
                        Loop
                        
                        StatusBar "Updating ProductID: " & rsProductID!TTechID & " (" & intCounter & " of " & rsProductID.RecordCount & ") -  Array Updated"
                        
                        'go back to the beginning
                        rsProductList.MoveFirst
                        
                        StatusBar "Updating ProductID: " & rsProductID!TTechID & " (" & intCounter & " of " & rsProductID.RecordCount & ") - " & rsProductList.Fields(a).Name
                        Debug.Print rsProductID!TTechID
                        
                        'Determine whether this column is text or number
                        Select Case FieldTypeName(rsProductList.Fields(a))
                                               
                            Case -1 'Boolean
                                If arrProducts(0, a) = arrProducts(1, a) Then
                                    'do nothing they are equal
                                Else 'They are different
                                    'Perform update
                                    If oProduct.UpdateProduct(rsProductList.Fields(a).Name, arrProducts(1, a), True, mlVendorID) = True Then '
                                        'Successful update
                                    Else
                                        MsgBox "Error Occured while updating: " & vbCrLf & "Product ID: " & rsProductList.Fields(1) & vbCrLf & "Column Name: " & rsProductList.Fields(a).Name, vbCritical + vbInformation, "Error Updating"
                                    End If
                                End If
                                
                                
                            Case 0 'text
                                If arrProducts(1, a) <> "" Then 'skip altogether, it's blank
                                    If TextDifferences(arrProducts(0, a), arrProducts(1, a)) = True Then 'They are different
                                        'Perform update
                                        If oProduct.UpdateProduct(rsProductList.Fields(a).Name, arrProducts(1, a), True, mlVendorID) = True Then '
                                            'Successful update
                                        Else
                                            MsgBox "Error Occured while updating: " & vbCrLf & "Product ID: " & rsProductList.Fields(1) & vbCrLf & "Column Name: " & rsProductList.Fields(a).Name, vbCritical + vbInformation, "Error Updating"
                                        End If
                                        
                                    End If
                                End If
                            Case 1 'number
                                If arrProducts(1, a) <> "" Then 'skip altogether, it's blank
                                    If NumberDifferences(arrProducts(0, a), arrProducts(1, a)) = False Then 'They are different
                                        'Perform update
                                        If oProduct.UpdateProduct(rsProductList.Fields(a).Name, arrProducts(1, a), True, mlVendorID) = True Then '
                                            'Successful update
                                        Else
                                            MsgBox "Error Occured while updating: " & vbCrLf & "Product ID: " & rsProductList.Fields(1) & vbCrLf & "Column Name: " & rsProductList.Fields(a).Name, vbCritical + vbInformation, "Error Updating"
                                        End If
                                        
                                    End If
                                End If
                            Case 2 'date
                        
                            Case Else
                        
                        End Select
                    
                    Next 'Column in recordset
                
                End If
            
            End If
            
            rsProductID.MoveNext
            intCounter = intCounter + 1
        Loop
    
    End If

End If

DataChangesMade = True

Debug.Print "Data Changes Made: " & gOTimer.TimeElapsed & vbCrLf & "Item Name: " & oProduct.ItemName & "  Item Number: " & oProduct.ProductID

StatusBar "Product Update Complete!"

Done:
On Error Resume Next
    rsProductList.Close
    Set rsProductList = Nothing
    
    rsProductID.Close
    Set rsProductID = Nothing
    Exit Function

HandleErr:
    MsgBox "Error While Auto Updating Products for Vendor: " & vbCrLf & Me.strVName, vbCritical + vbInformation, "Error Auto Update"
    If MsgBox("Would you like to quit HomeBase?", vbQuestion + vbYesNo, "Quit?") = vbYes Then DoCmd.Quit
    Resume Done

End Function

Open in new window

0
Comment
Question by:w00tw00t111
  • 7
  • 6
  • 4
17 Comments
 
LVL 47

Assisted Solution

by:Dale Fye (Access MVP)
Dale Fye (Access MVP) earned 200 total points
ID: 36816082
I would start out by putting a DoEvents as the first line inside every While/Wend, Do/Loop, and For/Next construct.
0
 
LVL 57
ID: 36816141

I'd skip the record count and this:

               'Move through entire recordset to get correct record count
                rsProductList.MoveLast
                rsProductList.MoveFirst

  You should be closing the recordsets and setting them to nothing:

  rsProductList.Close
  Set rsProductList = Nothing

  DoEvent would not help.  It yields processing time to other programs, which is not what you want.

  Beyond that, you updating fields in each record one at a time?

  If oProduct.UpdateProduct(rsProductList.Fields(a).Name, arrProducts(1, a), True, mlVendorID) = True Then '
                                            'Successful update


  That sounds like an inefficent way of going about things, but then I'm not totally understanding what it is your trying to accomplish.

Jim.
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 36816201
Get rid of lines 49-51 and the associated End If (line 169) as they accomplish nothing that the While statement on line 53 doesn't already take care of.

Stop refering to the RecordCount property of the recordset.  Get this value once for each recordset and store it in a varaible, then use that variable.  I use a function for this, which avoids me having to movelast, movefirst ... in my main code

Public Function fnRecCount(rs As DAO.Recordset) As Long

    If Not rs.EOF Then rs.MoveLast
    fnRecCount = rs.RecordCount
    If Not rs.BOF Then rs.MoveFirst
   
End Function


0
 
LVL 57
ID: 36816236
@fyed,

 <<Get rid of lines 49-51 and the associated End If (line 169) as they accomplish nothing that the While statement on line 53 doesn't already take care of.>>

  He's displaying an accurate progess bar, so if he really needs to keep that, then he
needs to do the movelast/first.   I'd certainly get rid of the one in the middle loop though at the very least.

  I think though the real problem is the updates field by field.   Instead, I would construct an SQL Update on the fly and hit the entire record at one time.

Jim.

0
 

Author Comment

by:w00tw00t111
ID: 36816263
Fyed, thank you for your response. As Jim mentioned, I was under the impression that DoEvents would not help things either. I've tried it and the same problem results.

Jim, the movelast/movefirst is to get an accurate recordcount so the statusbar message could tell me:

1 of 100 records updated, 2 of 100 updated, etc. etc.
Is that movelast calculation that resource taxing?

In my "Done:" code you will see that I'm closing and setting the recordsets to nothing (and if they were never set, the error handling skips any errors)

The reason for updating fields one record (and one column) at a time is this:
We are importing a xls file into a temp table in the access db. Some of these records in the temp table already exist in the db. So first a procedure runs to update the temp table with the associated access Product ID for the records that are already entered. (line 45)

Then for the products already in access, the temp table may have updated information i.e. product description has changed, price, inventory level, etc.
But not every column in the temp table needs to be evaluated for a change and not every column in the access table needs to be evaluated.

So a recordset is created that is specific for one ID and the information from the product table and the temp table. This is then loaded into an array (line 75-103)
Then, each column of the array is evaluated to first:
See what data type it is and then 2ndly compare the two values (temp table and access product table). If the values are different, an update is performed (update method also creates an audit trail of what was changed, when, and what the previous value was).
If the values are the same it skips to the next column or next product (if all columns have been evaluated).


I'm open to suggestions, as I could certainly have missed something, however seeing as though a column by column audit trail was required along with having to compare columns for differences before updating this was the only way that *successfully* worked. (Until now that I try and run it with thousands of records instead of hundreds).
0
 

Author Comment

by:w00tw00t111
ID: 36816289
Fyed, will do - I can certainly make the change to store the recordcount in a variable.

Jim, I'm with you and am pretty confident that's where the problem is as well, however given the requirements in the post above, I'm not sure how to get around it. Further, the code has been tested for hours and hours for correct logic and the logic finally works...however not in such quantity.
0
 
LVL 57
ID: 36816329
<<In my "Done:" code you will see that I'm closing and setting the recordsets to nothing (and if they were never set, the error handling skips any errors)>>

  Yes, but for rsProductList your only doing it at the end of the procedure, yet you opening it repeatedly inside your Product ID loop.  You need it in the loop as well as in the Done section (for cleanup on an error).

<<I'm open to suggestions, as I could certainly have missed something, however seeing as though a column by column audit trail was required along with having to compare columns for differences before updating this was the only way that *successfully* worked. (Until now that I try and run it with thousands of records instead of hundreds). >>

  Update the record in one shot.  Field by field is too inefficent.  Compare the columns one by one and write your audit trail, then update the record.

 I would have also skipped the array; read the spreadsheet row by row, fetch the record, compare column by column and note changes, then update the record.

Jim.
0
 
LVL 57
ID: 36816347
<< I would have also skipped the array; read the spreadsheet row by row, fetch the record, compare column by column and note changes, then update the record.>>

   Make that temp table, not spreadsheet.  I don't see the need for the array at all.

Jim.
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:w00tw00t111
ID: 36816361
Ahhh...So the comparison isn't what's taking forever and a day, it is the literal update to the recordset?

So if I understand correctly:
1. Compare records for differences
2. If different, run the audit procedure (although an edit has not been made yet)
3. After all records and columns have been compared, run one update query for all records

Is that the line of thinking?

<< I would have also skipped the array; read the spreadsheet row by row, fetch the record, compare column by column and note changes, then update the record.>>
As the records may not be in the correct order to compare, would it be more efficient to apply a filter for the current ID in question, do comparisons, remove filter, and then apply a new filter for the next ID.
Versus the array method.
?

Thank you very much for your expertise!
0
 
LVL 57

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 300 total points
ID: 36816513
<<Ahhh...So the comparison isn't what's taking forever and a day, it is the literal update to the recordset?>>

  Hard to say what exactly is taking the time, but certainly updating field by field is not as efficent as writting the record in one shot.

<<So if I understand correctly:
1. Compare records for differences
2. If different, run the audit procedure (although an edit has not been made yet)
3. After all records and columns have been compared, run one update query for all records>>

  Basically yes and #2 is the kicker.  If you absolutely need to make sure that the existance of the audit records means the record was changed, then I'd write them both out in a transaction.  If either fails, then neither will get written.

 As for number #3 and your saying records (implying multiple), I'm not sure I totally understanding the update that needs to take place.  I see this more as a one for one match up.  But even if there are multiple records in the DB for one row of the temp table, then I still don't see the need for the array.  You would just have more records in the recordset of found items and need to loop through it performing the same processing if there was only a single record.

  And as an aside, since your using DAO, the fastest way to find a single record is by using a .Seek on an index (assuming you have one that can locate the record).  It is by far the fastest way to find something and is something you should look at using any time you have intensive updates like your trying to do.

  You may be able to do this instead of repeatedly opening a recordset with only the records that need to be updated inside the loop.

Jim.


0
 

Author Comment

by:w00tw00t111
ID: 36816542
So for #2, you are not suggesting I update the entire database in one shot (i.e. all 9,000 records) but instead, just update the 1 record (and all columns) instead of updating column by column. Is that correct?

I'll look into seek instead of filter.
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 36816576
I  ALWAYS add DoEvents inside of any kind of loop, so that I can multi-task while the application is running.  Agree that it would not improve the speed.

Agree with JD that changing the data one field at a time is inefficient.

I would probably test the values of the old and new records and build a SQL string that updates the appropriate fields, based on those values, then execute the SQL string using the execute method.  I would recommend doing this and your audit trail updates within a BigTrans/CommitTrans/Rollback block so that if any of the updates or audit trail additions fail, you could roll back the update for that particular record.

0
 

Author Comment

by:w00tw00t111
ID: 36817346
Sounds good, I'm working on this now and will update you all with the results. Thanks!
0
 

Author Comment

by:w00tw00t111
ID: 36893292
Alrighty Experts, you want to talk about great advice!

I narrowed the updated from 2hrs 30 minutes or so, to under a minute!!

Essentially what I did was speak with the project manager to see if we needed an audit trail on every column. It turns out we didn't. We only needed it on two  - price changes and inventory changes. So i rewrote the code to go through record by record for those two columns and individually log changes in the audit table. Then it does a bulk update for all of the other columns.

And as I mentioned this works splendidly well!
Code is attached below:
 
'============================================
Public Function DataChangesMade() As Boolean
'============================================
'Purpose: Compare Products in latest data download with what is currently in main product database
'Requires: Data matching between main product table and current vendor table
'Returns: True if data was correctly updated

On Error GoTo HandleErr
    
DataChangesMade = False

'time testing
gOTimer.StartCounter

StatusBar "Updating Product Information..."

DoEvents

Dim strSql
Dim rs As DAO.Recordset
Dim rsNew As DAO.Recordset
Dim rsColumn As DAO.Recordset
Dim oProduct As cProducts
Set oProduct = New cProducts


'###############################################
'INVENTORY UPDATE
StatusBar "Updating Inventory..."
Set rsColumn = LoadColumnList("Inventory")
'Get's the most recent inventory level and then subtracts the current import's inventory level
'       We only need the inventories that are <> 0! If Difference isn't = 0 then that means something has changed and we need to update it!
strSql = "SELECT DISTINCT t1.Inventory, t1.TTechID, [" & rsColumn!Vendorcolumn & "]-[Inventory] AS Difference, [" & rsColumn!Vendorcolumn & "] AS NewInventory" & _
         " FROM " & Me.strVSourceTable & " INNER JOIN (tblProductInventory AS t1 INNER JOIN [SELECT a.TTechID as ID, Max(a.LastUpdate) as Max_LastUpdate" & _
         " FROM tblProductInventory a" & _
         " GROUP BY a.TTechID" & _
         "]. AS t2 ON (t1.LastUpdate = t2.Max_LastUpdate) AND (t1.TTechID = t2.ID)) ON " & Me.strVSourceTable & ".TTechID = t1.TTechID" & _
         " WHERE (((t1.VendorID)=" & mlVendorID & "));"

Set rs = CurrentDb.OpenRecordset(strSql)

rs.Filter = "Difference <> 0"
Set rsNew = rs.OpenRecordset

'rsnew now contains only records with a change in their inventories
    'start looping through to make updates and audit trail!
Do Until rsNew.EOF
DoEvents
    oProduct.ProductID = rsNew!TTechID
    
    If oProduct.UpdateProduct("Inventory", rsNew!NewInventory, True, mlVendorID) = True Then
        
    End If

rsNew.MoveNext
Loop

'Done with recordsets, close'm
rsColumn.Close
Set rsColumn = Nothing
rs.Close
Set rs = Nothing
rsNew.Close
Set rsNew = Nothing
'############################################


'############################################
'PRODUCT COST UPDATE
StatusBar "Updating Product Costs..."
Set rsColumn = LoadColumnList("ProductCost")
'Get's the most recent inventory level and then subtracts the current import's inventory level
'       We only need the inventories that are <> 0! If Difference isn't = 0 then that means something has changed and we need to update it!
strSql = "SELECT DISTINCT t1.ProductCost, t1.TTechID, [" & rsColumn!Vendorcolumn & "]-[ProductCost] AS Difference, [" & rsColumn!Vendorcolumn & "] AS NewCost" & _
         " FROM " & Me.strVSourceTable & " INNER JOIN (tblProductCost AS t1 INNER JOIN [SELECT a.TTechID as ID, Max(a.DateUpdated) as Max_LastUpdate" & _
         " FROM tblProductCost a" & _
         " GROUP BY a.TTechID" & _
         "]. AS t2 ON (t1.DateUpdated = t2.Max_LastUpdate) AND (t1.TTechID = t2.ID)) ON " & Me.strVSourceTable & ".TTechID = t1.TTechID" & _
         " WHERE (((t1.VendorID)=" & mlVendorID & "));"

Set rs = CurrentDb.OpenRecordset(strSql)

rs.Filter = "Difference <> 0"
Set rsNew = rs.OpenRecordset

'rsnew now contains only records with a change in their inventories
    'start looping through to make updates and audit trail!
Do Until rsNew.EOF
DoEvents
    oProduct.ProductID = rsNew!TTechID
    
    If oProduct.UpdateProduct("ProductCost", rsNew!NewCost, True, mlVendorID) = True Then
        
    End If

rsNew.MoveNext
Loop

'Done with recordsets, close'm
rsColumn.Close
Set rsColumn = Nothing
rs.Close
Set rs = Nothing
rsNew.Close
Set rsNew = Nothing

'########################################


'########################################
'FULL Product Update on tblProductMain

'Now loop through import columns to get the list of what to set what to
'   Need: tmp tables column name
'         Matching column name for tblProductMain
'         Set logic is: Main.[ColumnName] = SOURCE.[ColumnName],
'         Remove last "," at the end

'Building list of columns
'   Need: only tblProductMain columns b/c that's all we are updating
'         Only matching columns for this specific vendor
'         Only columns where import is true

StatusBar "Updating tblProductMain..."

strSql = "SELECT tblVendorMatchingColumn.VendorColumn, tblExportFields.ColumnName, tblExportFields.TableName, tblExportFields.Import, tblVendorMatchingColumn.VendorID" & _
         " FROM tblVendorMatchingColumn INNER JOIN tblExportFields ON tblVendorMatchingColumn.MatchColumn = tblExportFields.ExportFieldID" & _
         " WHERE (((tblExportFields.TableName)='tblProductMain') AND ((tblExportFields.Import)=True) AND ((tblVendorMatchingColumn.VendorID)=" & mlVendorID & "));"

Set rsColumn = CurrentDb.OpenRecordset(strSql)
         
'Creating update query
strSql = "UPDATE " & Me.strVSourceTable & " SOURCE INNER JOIN " & scMainTable & " MAIN ON SOURCE.TTechID = MAIN.TTechID SET "
         
'Begin looping through necessary columns
Do Until rsColumn.EOF
DoEvents
    strSql = strSql & "MAIN.[" & rsColumn!ColumnName & "]=SOURCE.[" & rsColumn!Vendorcolumn & "], "

rsColumn.MoveNext
Loop

'Remove trailing ", "
strSql = Left(strSql, Len(strSql) - 2)

'Run update
CurrentDb.Execute strSql

rsColumn.Close
Set rsColumn = Nothing
'########################################


'########################################
'FULL Product Update on Img Table

'Now loop through import columns to get the list of what to set what to
'   Need: tmp tables column name
'         Matching column name for tblProductImage
'         Set logic is: Main.[ColumnName] = SOURCE.[ColumnName],
'         Remove last "," at the end

'Building list of columns
'   Need: only tblProductImage columns b/c that's all we are updating
'         Only matching columns for this specific vendor
'         Only columns where import is true

StatusBar "Updating Image Table..."

strSql = "SELECT tblVendorMatchingColumn.VendorColumn, tblExportFields.ColumnName, tblExportFields.TableName, tblExportFields.Import, tblVendorMatchingColumn.VendorID" & _
         " FROM tblVendorMatchingColumn INNER JOIN tblExportFields ON tblVendorMatchingColumn.MatchColumn = tblExportFields.ExportFieldID" & _
         " WHERE (((tblExportFields.TableName)='tblProductImage') AND ((tblExportFields.Import)=True) AND ((tblVendorMatchingColumn.VendorID)=" & mlVendorID & "));"

Set rsColumn = CurrentDb.OpenRecordset(strSql)
         
If rsColumn.RecordCount <> 0 Then
    'Creating update query
    strSql = "UPDATE " & Me.strVSourceTable & " SOURCE INNER JOIN tblProductImage MAIN ON SOURCE.TTechID = MAIN.TTechID SET "
                      
    'Begin looping through necessary columns
    Do Until rsColumn.EOF
    DoEvents
        strSql = strSql & "MAIN.[" & rsColumn!ColumnName & "]=SOURCE.[" & rsColumn!Vendorcolumn & "], "
    
    rsColumn.MoveNext
    Loop
    
    'Remove trailing ", "
    strSql = Left(strSql, Len(strSql) - 2)
    
    'Run update
    CurrentDb.Execute strSql

End If

rsColumn.Close
Set rsColumn = Nothing
'#######################################
    

'Wrap up!
DataChangesMade = True
Debug.Print "Data Changes Made: " & gOTimer.TimeElapsed
StatusBar "Product Update Complete!"



Done:
On Error Resume Next
    rsColumn.Close
    Set rsColumn = Nothing
    rs.Close
    Set rs = Nothing
    rsNew.Close
    Set rsNew = Nothing
    
    Exit Function

HandleErr:
    MsgBox "Error While Auto Updating Products for Vendor: " & vbCrLf & Me.strVName, vbCritical + vbInformation, "Error Auto Update"
    If MsgBox("Would you like to quit HomeBase?", vbQuestion + vbYesNo, "Quit?") = vbYes Then DoCmd.Quit
    Resume Done

End Function

Open in new window


Points will be split 200/300 as most suggestions that were adapted were from Jim. But thank you both for your advice!

As an aside, the transactions and audit updates are in the ProductUpdate function.
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 36893380
Heck,  I expected them (points) to all go to Jim.
0
 

Author Comment

by:w00tw00t111
ID: 36893391
The do events helped the counter on the status bar to work which was 'critical' for my boss :)

I really appreciate both of y'all - thank you!
0
 
LVL 57
ID: 36893458
<<I narrowed the updated from 2hrs 30 minutes or so, to under a minute!!>>

  Very good!  Just remember; we provided the guidance, you did all the work ;)

Jim.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

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…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
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…

759 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

19 Experts available now in Live!

Get 1:1 Help Now