Slow Table Update

[dtaylor]

Hello All - to give a little primer on what i am doing. I am building an app that takes a weekly extract and populates a table for analysis. I am tracking my data by week. I have 3 table that are in question here:
1. My main table holding historical data. Has a field for contract id(indexed to accept no dups) and one field for each fiscal week of the year.
2. Temp table that is populated with weekly import. Has contract id, fiscal week and sales.
3. A table that holds one record for the current fiscal week.

My main table holds all the contracts i am tracking for my division (roughly 12m lines). I have a field for each fiscal week (1,2,3,4,ect.).
The temp table holds all contracts for one week being uploaded. Usually will be about 6m contracts that had sales the previous week.
The current fiscal week is extracted from the temp table and placed in the third table. This record is used to tell the routine which field to upload data to.

This only a piece of my overal app but I cannot continue until get this down since my data analysis/retrival is dependent on my main table.

I have written a piece of code that works the way I want it to but it takes about 25mins to run. A buddy of mine suggested SQL Batch Update, but I have barely read about this and never tried.

If someone can take a look at this code and maybe have a better solution I would be much appreciated.

Thanks!

Private Const tblPMSales As String = "tblPriceMethods_Sales"
Private Const tblPMImport As String = "tblPriceMethodsTemp"
Private Const tblWeek As String = "tblWeek"
Private Const fldWk As String = "Week"
Private Const fldContract As String = "Contract ID"
Private Const fldPMImportSalse As String = "Total Sales"

Sub PMUpdate()
Dim rstPM As ADODB.Recordset
Dim rstPMImp As ADODB.Recordset
Dim rstWK As ADODB.Recordset
Dim i As String

Set rstPM = New ADODB.Recordset
Set rstPMImp = New ADODB.Recordset
Set rstWK = New ADODB.Recordset

rstPM.CursorLocation = adUseServer

rstPM.Open tblPMSales, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTableDirect 'Main Table
rstWK.Open tblWeek, CurrentProject.Connection, adOpenForwardOnly ' Table holding current fiscal week
rstPMImp.Open tblPMImport, CurrentProject.Connection, adOpenForwardOnly ' Table holding uploaded data


Do While Not rstPMImp.EOF
rstPM.MoveFirst
Do While Not rstPM.EOF
i = rstWK.Fields(fldWk)
If rstPM.Fields(fldContract) = rstPMImp.Fields(fldContract) Then
rstPM.Fields(i) = rstPMImp.Fields(fldPMImportSalse)
End If

rstPM.MoveNext
Loop
rstPMImp.MoveNext
Loop
ExitHere:
On Error Resume Next
rstWK.Close
rstPMImp.Close
rstPM.Update
rstPM.Close

Set rstWK = Nothing
Set rstPM = Nothing
Set rstPMImp = Nothing

Exit Sub
End Sub

 

[dtaylor]

Not a problem - once i get all of this digested into my app i will post the results. Today I will not be able to get to it, had meetings this morning and my plate has grown....

Dan

 

[PaulF]

Hi

Just a thought, that doesn't require code. Perhaps you have already been down this road. If you set up your data table with a single field for week, and just append each weeks data to the table. Then you can use a crosstab query to display the data as array with the weeks across.

You could also connect a pivot table directly to the data table and create the same result and other analysis as well.

It may be too late for this approach, but it may come in handy in other cases.

Hope this doesn't confuse the issue.

Paul

 

[dtaylor]

PaulF - thanks for the suggestion. But there is one thing, in relation to my current app. The data being uploaded each week will change, each week will be a new field (1,2,3,4..ect). For ease of use I am using the actual fiscal week for the field names.
Currently with each upload a field is created on my main table based on the
current fiscal week, which is a field on my import.
This is the field that is uploaded to on my table, so essentially by the end of Dec I will have 52 sales fields.
How can use a crosstab query and not have any user intervention to have to point to the correct field? I am thinking about this,and I have used cross-tabs in the past, and I can not see how I can do that. I know how I can change up the tblWeek without code but how would I point to the correct week in the crosstab?

I want the whole process to happen with minimal user intervention.

Thanks for all the suggestions on this thread. There is some really good information, more than one to skin a cat!

Dan

 

[PaulF]

Hi Dan

The main data table would have three fields-Fiscal_wk, customerID, and Data. Each week the current week's data would be appended to this table.

From this main data table, the crosstab query would be done. The field Fiscal_Wk would automatically populate the "columns" of your crosstab. No user intervention required once the current data is appended to the database.

Hope this is clearer.

Paul

 

[mdmilner]

hmmm

Did a partial test - I have a complication. I think this may have shaved 20-25% off the processing time, but I ran into a complication. I'm creating a qdf object as part of the process and it doesn't like being in a transaction so I had to only use the transaction within the existing loop instead of for multiple passes.

A few of the things I've tried - visible below is store a bunch of dates in an array insead of using a recordset to loop around it. I figured the memory overhead would be lower. The DAO AddNew seems to be fast, but, the insertion queries based on parameters slow things down.

I'm really thinking the best and simplest method might be to dynamically split the table into two or more pieces and then work with it.

Mike

Public Function MakeZoneEntry(ByVal strVal As String, _
                             Optional dteDate As Date, _
                             Optional remoteDB As String) As Boolean
Dim dbs As DAO.Database
Dim rs, rsOut, rsLoco, rsCount As DAO.Recordset
Dim zoneIndex As Long 'lngFld, x,
Dim strSQL As String
Dim qdf As DAO.QueryDef
Dim retVal As Variant
Dim afterconfirm As Date
Dim x, y As Long
Dim dteVal() As Date
Dim wksp As DAO.Workspace

On Error GoTo HandleErr
Set dbs = CurrentDb
Set wksp = DBEngine.Workspaces(0) ' set up a transaction buffer

strSQL = strSQL & "SELECT DISTINCT Format([PINGTIME],'mm/dd/yyyy') AS dte "
strSQL = strSQL & "FROM [" & strVal & "] "
Set rs = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
With rs
  x = -1
  .MoveLast
  ReDim dteVal(.RecordCount)
  .MoveFirst
  Do Until rs.EOF
    x = x + 1
    dteVal(x) = .Fields(0).Value
    .MoveNext
  Loop
End With
Set rs = Nothing



strSQL = "SELECT * FROM tblOutput"
Set rsOut = dbs.OpenRecordset(strSQL, dbOpenDynaset)

If Len(remoteDB) > 0 Then rs.FindFirst "dte='#" & dteDate & "#'"

'With rs
'  Do Until rs.EOF
  For y = 0 To x
    If Len(dteVal(y)) > 0 And Year(dteVal(y)) > 2000 Then

       If ConfirmWriteZone(strVal, dteVal(y)) Then
wksp.BeginTrans ' all record set changes are buffered after this

afterconfirm = Time
         retVal = SysCmd(1, "Zoning " & strVal & " " & dteVal(y), 1)
         'Debug.Print rs.Fields(0).Value
         rsOut.AddNew
         rsOut.Fields(0).Value = UCase(Left(strVal, 3)) 'term abbreviation
         rsOut.Fields(1).Value = dteVal(y)     'date from pivot
         zoneIndex = rsOut.Fields(2).Value              'grabs index value
         rsOut.Update
'Debug.Print Time & " added to output"

         strSQL = "INSERT INTO tblZones ( indexID, [zone], [count] ) "
         strSQL = strSQL & "SELECT '" & zoneIndex & "' AS fld1, "
         strSQL = strSQL & "zonedetected, Count(zonedetected) AS cntzone "
         strSQL = strSQL & "FROM [" & strVal & "] "
         strSQL = strSQL & "Group By '" & zoneIndex & "', "
         strSQL = strSQL & "Format([PINGTIME],'mm/dd/yyyy'), zonedetected "
         strSQL = strSQL & "HAVING (Format([PINGTIME],'mm/dd/yyyy')="
         strSQL = strSQL & "'" & dteVal(y) & "')"
         'On Error Resume Next
         'DoCmd.DeleteObject acQuery, "tmp1"
         'On Error GoTo HandleErr
         'Set qdf = dbs.CreateQueryDef("tmp1", strSQL)
         'DoCmd.OpenQuery "tmp1", , acEdit
         Call DoRunSQL(strSQL, "MakeZoneEntry")
'Debug.Print Time & " inserted into tblzones"
         'DoCmd.RunSQL strSQL
wksp.CommitTrans
         If ObjectExists("Query", "qryTMPdwell") Then
           DoCmd.DeleteObject acQuery, "qryTMPdwell"
         End If
         strSQL = "SELECT DISTINCT zonedetected, UNIT, "
         strSQL = strSQL & "Format([PINGTIME],'mm/dd/yyyy') AS myTime "
         strSQL = strSQL & "FROM " & strVal & " "
         strSQL = strSQL & "WHERE Format([PINGTIME],'mm/dd/yyyy')='"
         strSQL = strSQL & dteVal(y) & "' "
         Set qdf = dbs.CreateQueryDef("qryTMPdwell", strSQL)
'Debug.Print Time & " created qdf"

         strSQL = "INSERT INTO tblDwell ( indexID, [zone], [count] ) "
         strSQL = strSQL & "SELECT '" & zoneIndex & "' AS fld1, "
         strSQL = strSQL & "zonedetected, Count(UNIT) AS cntzone "
         strSQL = strSQL & "FROM qryTMPdwell "
         strSQL = strSQL & "Group By '" & zoneIndex & "', zonedetected "
         Call DoRunSQL(strSQL, "MakeZoneEntry")
'Debug.Print Time & " inserted into tblDwell"
         'DoCmd.RunSQL strSQL

         strSQL = "SELECT DISTINCT UNIT FROM " & strVal
         strSQL = strSQL & " WHERE PINGTIME >= #" & dteVal(y) & "#"
         strSQL = strSQL & " AND PINGTIME < #"
         strSQL = strSQL & DateAdd("d", 1, dteVal(y)) & "#"
         Set rsCount = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
         
         If Len(strVal) > 3 Then
           If doSpecialFormat(Left(strVal, 3)) Then
             Call doLocoFormat(strVal, rsLoco, strSQL, zoneIndex)
           Else
             strSQL = "SELECT * FROM tblLoco"
             Set rsLoco = dbs.OpenRecordset(strSQL, dbOpenDynaset)
             If rsCount.RecordCount > 0 Then
                rsCount.MoveLast
                rsLoco.AddNew
                rsLoco.Fields(1).Value = zoneIndex
                rsLoco.Fields(3).Value = rsCount.RecordCount
                rsLoco.Update
             End If
             Set rsLoco = Nothing
           End If
         End If
'Debug.Print Time & " done with loco count"
Debug.Print afterconfirm & " start " & Time & " done before logs " & dteVal(y)
       ' create log entry
         Call GenerateLogs("tblLogs", UCase(strVal), _
                    "Create Zone Entry", "Success", strVal, , Now)
         Call ShowZoned(strVal)
       Else
         Call GenerateLogs("tblLogs", UCase(strVal), _
                    "Create Zone Entry", "Failed", strVal, , Now)
       ' create failed log entry
         'Exit Do
       End If  ' ConfirmWrite
'Debug.Print Time & " done with logging"

    End If
    '.MoveNext
    Next y
  'Loop
'End With


MakeZoneEntry = True
ExitHere:
SysCmd (3)
Set rsCount = Nothing
Set rsLoco = Nothing
Set rsOut = Nothing
Set rs = Nothing
Set dbs = Nothing
    Exit Function

' Error handling block added by Error Handler Add-In. DO NOT EDIT this block of code.
' Automatic error handler last updated at 09-16-2005 15:38:08   'ErrorHandler:$$D=09-16-2005    'ErrorHandler:$$T=15:38:08
HandleErr:
    Select Case Err.Number
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "modManageTables.MakeZoneEntry" 'ErrorHandler:$$N=modManageTables.MakeZoneEntry
    End Select
    MakeZoneEntry = False
    wksp.Rollback ' cancel everything if unexpected error
    GoTo ExitHere
' End Error handling block.
End Function

 

[mdmilner]

Ack - sorry guys. I posted the above on the wrong thread completely.

I'll repost - perhaps an admin wants to purge it for me.

Mike