Indexing a large table that is updated in chunks of about 17K records at a time

thechazm

VBA, VB.net, C#, Java
Local time
Yesterday, 21:43
Joined
Mar 7, 2011
Messages
515
I am trying to figure out what the proper indexing should be to maximize my searching ability but also give me the fastest update ability. The tables in itself are very simplistic but after the rows reach about 17K or so it starts to slow down and I am pretty sure its my indexing that's causing it.

Any inputs on this are greatly appreciated.

Table Makeup:
Table Name - [Other Events]

Fields:
ID - AutoNumber and Primary Key
Shop ID - Long Integer
Project ID - Long Integer
Badge - Text (Limited to 6 characters)
Start Date - Date/Time Field as (Short Date)
Total Time - Integer

Indexes:
Index Name, Field Name, Sort Order

ID, ID, Ascending
PrimaryKey, ID, Ascending
Project ID, Project ID, Ascending
Shop ID, Shop ID, Ascending


In my code I use this search to find if the record is there if not then it creates a new one.

Thanks for the help everyone in advance,

TheChazm
 
Sorry forgot to post my code...

Code:
rs2.FindFirst "[Shop ID] = " & LookupShopMod(CStr(var(ii, 1))) & " AND [Project ID] = " & LookupProjectMod(strProject) & " AND [Badge] = """ & CStr(var(ii, 2)) & """ AND [Start Date] = #" & Format(CDate(var(ii, 11)), "Short Date") & "# AND [Total Time] = " & CLng(var(ii, 12))
 
Is there a reason why you need to use FindFirst and not just use that criteria on the recordset's SQL to begin with?
 
Yes because this checks every record being imported so I have to search to see if that record has already been imported. About 17 thousand rows of data every sync operation it has to go through.
 
Here is my core function to do what I am talking about maybe that will clear up any questions or maybe I'm going about this the wrong way I dunno but here it is.

Code:
Function ImportTAndL(strFile As String)
Dim xlsApp As Excel.Application, xlsWorkbook As Excel.Workbook, xlsSheet As Excel.Worksheet
Dim db As Database, rs As DAO.Recordset, rs2 As DAO.Recordset
Dim strProject As String, strBadge As String
Dim rng As Range
Dim var() As Variant
If strFile = "" Then
    bCanceled = True
    Exit Function
Else
    bCanceled = False
End If
Set xlsApp = New Excel.Application
Set xlsWorkbook = xlsApp.Workbooks.Open(strFile)
Set xlsSheet = xlsApp.Worksheets(1)
Set db = CurrentDb
Set dbLookup = CurrentDb
Set rs = db.OpenRecordset("Select * from [Training]", dbOpenDynaset)
Set rs2 = db.OpenRecordset("Select * from [Other Events]", dbOpenDynaset)
Set rsShop = dbLookup.OpenRecordset("Select * from [Shops]", dbOpenSnapshot)
Set rsProject = dbLookup.OpenRecordset("Select * from [Project Name Ref]", dbOpenSnapshot)
i = xlsSheet.Cells(xlsSheet.Rows.Count, "B").End(xlUp).Row
ReDim var(1 To i, 1 To 17)
        
Set rng = xlsSheet.Range("B2:Q" & i)
var = rng.value
        
For ii = LBound(var) To UBound(var)
    'HS(1), BADGE(2), LAST_NM(3), Project(4), Supv(5), Supervisor(6),
    'Supv_Project(7) Text46(8), CLASS(9), TITLE(10), START_DT(11),
    'END_DT(12), BLDG(13), FLOOR(14), ROOM(15), Instructor(16)
    StatusLabel ii & " - " & i
    If Len(var(ii, 12)) > 3 Then
    
        If Len(CStr(var(ii, 4))) > 3 Then
            strProject = Left(CStr(var(ii, 4)), 3)
        Else
            strProject = CStr(var(ii, 4))
        End If
        
        If Len(CStr(var(ii, 2))) = 5 Then
            strBadge = "0" & CStr(var(ii, 2))
        Else
            strBadge = CStr(var(ii, 2))
        End If
        
        rs.FindFirst "[Shop ID] = " & LookupShopMod(CStr(var(ii, 1))) & " AND [Project ID] = " & LookupProjectMod(strProject) & " AND [Badge] = """ & strBadge & """ AND [Start Date] = #" & CDate(var(ii, 11)) & "# AND [End Date] = #" & CDate(var(ii, 12)) & "#"
        If rs.NoMatch = True Then
            With rs
                .AddNew
                ![Shop ID] = LookupShopMod(CStr(var(ii, 1)))
                ![Project ID] = LookupProjectMod(strProject)
                ![Badge] = strBadge
                ![Start Date] = CDate(var(ii, 11))
                ![End Date] = CDate(var(ii, 12))
                .Update
            End With
        End If
    Else
        If Len(CStr(var(ii, 4))) > 3 Then
            strProject = Left(CStr(var(ii, 4)), 3)
        Else
            strProject = CStr(var(ii, 4))
        End If
        
        If Len(CStr(var(ii, 2))) = 5 Then
            strBadge = "0" & CStr(var(ii, 2))
        Else
            strBadge = CStr(var(ii, 2))
        End If
                
        rs2.FindFirst "[Shop ID] = " & LookupShopMod(CStr(var(ii, 1))) & " AND [Project ID] = " & LookupProjectMod(strProject) & " AND [Badge] = """ & strBadge & """ AND [Start Date] = #" & Format(CDate(var(ii, 11)), "Short Date") & "# AND [Total Time] = " & CLng(var(ii, 12))
        If rs2.NoMatch = True Then
            With rs2
                .AddNew
                ![Shop ID] = LookupShopMod(CStr(var(ii, 1)))
                ![Project ID] = LookupProjectMod(strProject)
                ![Badge] = strBadge
                ![Start Date] = Format(CDate(var(ii, 11)), "Short Date")
                ![Total Time] = CLng(var(ii, 12))
                .Update
            End With
        End If
    End If
Next ii
xlsApp.Quit
Set xlsSheet = Nothing
Set xlsWorkbook = Nothing
Set xlsApp = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing
StatusLabel "Completed!"
rsProject.Close
rsShop.Close
Set rsProject = Nothing
Set rsShop = Nothing
Set dbLookup = Nothing

End Function
 
First off, I am not seeing anything (unless I'm missing something) that couldn't be accomplished by Append queries themselves with no recordsets.

But, let's say you need to use the recordsets. The way you do it is to modify like this:

Code:
Function ImportTAndL(strFile As String)
    Dim xlsApp As Excel.Application, xlsWorkbook As Excel.Workbook, xlsSheet As Excel.Worksheet
    Dim db As Database, 
    Dim rs As DAO.Recordset
    Dim strProject As String
    Dim strBadge As String
   [B][COLOR="Red"] Dim strSQL As String[/COLOR][/B]
    Dim rng As Range
    Dim var() As Variant

    If strFile = "" Then
        bCanceled = True
        Exit Function
    Else
        bCanceled = False
    End If

    Set xlsApp = New Excel.Application
    Set xlsWorkbook = xlsApp.Workbooks.Open(strFile)
    Set xlsSheet = xlsApp.Worksheets(1)
    Set db = CurrentDb

    Set rsShop = db.OpenRecordset("Select * from [Shops]", dbOpenSnapshot)
    Set rsProject = db.OpenRecordset("Select * from [Project Name Ref]", dbOpenSnapshot)

    i = xlsSheet.Cells(xlsSheet.Rows.Count, "B").End(xlUp).Row
    ReDim var(1 To i, 1 To 17)

    Set rng = xlsSheet.Range("B2:Q" & i)
    var = rng.Value

    For ii = LBound(var) To UBound(var)
        'HS(1), BADGE(2), LAST_NM(3), Project(4), Supv(5), Supervisor(6),
        'Supv_Project(7) Text46(8), CLASS(9), TITLE(10), START_DT(11),
        'END_DT(12), BLDG(13), FLOOR(14), ROOM(15), Instructor(16)
        StatusLabel ii & " - " & i
        If Len(var(ii, 12)) > 3 Then

            If Len(CStr(var(ii, 4))) > 3 Then
                strProject = Left(CStr(var(ii, 4)), 3)
            Else
                strProject = CStr(var(ii, 4))
            End If

            If Len(CStr(var(ii, 2))) = 5 Then
                strBadge = "0" & CStr(var(ii, 2))
            Else
                strBadge = CStr(var(ii, 2))
            End If

[B][COLOR="red"]            strSQL = "SELECT * from [Training] WHERE " & _
                     "[Shop ID] = " & LookupShopMod(CStr(var(ii, 1))) & " AND [Project ID] = " & LookupProjectMod(strProject) & " AND [Badge] = """ & strBadge & """ AND [Start Date] = #" & CDate(var(ii, 11)) & "# AND [End Date] = #" & CDate(var(ii, 12)) & "#"
[/COLOR][/B]
            [B][COLOR="red"]Set rs = db.OpenRecordset(strSQL)[/COLOR][/B]

            [B][COLOR="red"]If rs.RecordCount = 0 Then
                strSQL = "Insert Into [Training] ([Shop ID], [Project ID], [Badge], [Start Date], [End Date]) " & _
                         "VALUES (" & LookupShopMod(CStr(var(ii, 1))) & "," & LookupProjectMod(strProject) & "," & strBadge & _
                         "," & CDate(var(ii, 11)) & "," & CDate(var(ii, 12)) & ")"

                db.Execute strSQL, dbFailOnError

            End If[/COLOR][/B]
        Else
            If Len(CStr(var(ii, 4))) > 3 Then
                strProject = Left(CStr(var(ii, 4)), 3)
            Else
                strProject = CStr(var(ii, 4))
            End If

            If Len(CStr(var(ii, 2))) = 5 Then
                strBadge = "0" & CStr(var(ii, 2))
            Else
                strBadge = CStr(var(ii, 2))
            End If

[B][COLOR="red"]            strSQL = "Select * from [Other Events] " & _
                     "WHERE [Shop ID] = " & LookupShopMod(CStr(var(ii, 1))) & " AND [Project ID] = " & LookupProjectMod(strProject) & " AND [Badge] = """ & strBadge & """ AND [Start Date] = #" & Format(CDate(var(ii, 11)), "Short Date") & "# AND [Total Time] = " & CLng(var(ii, 12))

            Set rs = CurrentDb.OpenRecordset(strSQL)

            If rs.RecordCount = 0 Then

                strSQL = "Insert Into [Other Events] ([Shop ID],[Project ID],[Badge],[Start Date], [Total Time]) " & _
                         "VALUES(" & LookupShopMod(CStr(var(ii, 1))) & "," & LookupProjectMod(strProject) & "," & strBadge & _
                         "," & Format(CDate(var(ii, 11)), "Short Date") & "," & CLng(var(ii, 12)) & ")"

                db.Execute strSQL, dbFailOnError[/COLOR][/B]

            End If
        End If
    Next ii
    xlsApp.Quit
    Set xlsSheet = Nothing
    Set xlsWorkbook = Nothing
    Set xlsApp = Nothing
    rs.Close
    Set rs = Nothing

    StatusLabel "Completed!"
    rsProject.Close
    rsShop.Close
    Set rsProject = Nothing
    Set rsShop = Nothing


End Function
 
Thanks guy's for the input. I knew there was a better way but I was blinded and didn't think about that approach. I should have caught it but ow well.

Pat sorry for my code not being clear. I'll make the consideration the next time I ask for some help.

Appreciate the combined effort. Thanks,

TheChazm
 

Users who are viewing this thread

Back
Top Bottom