Results 1 to 9 of 9
  1. #1
    Sanguineus is offline Novice
    Windows 7 64bit Access 2016
    Join Date
    Dec 2018
    Posts
    19

    Code Optimisation

    I think I've code this code segement to run as fast as I am able but its still painfully slow so I'm wondering if anyone could help with some improvements.

    Returnarray will always be sized (1 to 70, 1 to 36)

    This is related to my earlier post where we are importing a manual item count, and may need to check that previously imported data in case there's been an amendment.

    Code:
    Option Compare Database
    Option Explicit
    Sub Import()
        Dim ReturnArray As Variant, vMonths As Variant
        Dim sSQL As String, Filepath As String, FileName As String, sYear As String, sYear2 As String, YearSelect As String
        Dim sClass As String, sWeight As String, sSource As String
        Dim ReportingDate As Date
        Dim i As Long, k As Long, l As Long, m As Long
        Dim j As Integer
        Dim icount As Long, Loops As Long, CheckM As Long
        Dim db As Database
        Dim appExcel As Excel.Application
        Dim wb As Excel.Workbook
        Dim n As Double
        
        Set appExcel = CreateObject("Excel.Application")
        
        Set db = CurrentDb
        
        sYear = IIf(Month(Date) < 4, Year(Date) + 1 & " " & Right(Year(Date) + 2, 2), Year(Date) & " " & Right(Year(Date) + 1, 2))
        sYear2 = IIf(Month(Date) < 4, Year(Date) + 1 & " " & Year(Date) + 2, Year(Date) & " " & Year(Date) + 1)
        Filepath = "IMPORT PATH" & sYear & "\Outgoing " & sYear2 & "\"
        
        vMonths = Array("April", "May", "June", "July", "August", "September", "October", "November", "December", "January", "February", "March")
        
        For i = 0 To UBound(vMonths)
            sYear = IIf(Month(Date) < 4, Year(Date) + 1, Year(Date))
            FileName = vMonths(i) & " " & sYear & ".xls"
            If i > Month(Date) - 4 Then Exit For
            
            Set wb = appExcel.Workbooks.Open(Filepath & FileName)
            appExcel.Visible = True
            
            For j = 1 To 31
            
                With wb.Worksheets(Addth(j))
                    ReturnArray = .Range(.Cells(1, 1), .Cells(70, 36)).Value
                End With
            
                For k = 5 To UBound(ReturnArray, 1)
                    For l = 4 To UBound(ReturnArray, 2)
                        On Error Resume Next
                        ReportingDate = CDate(j & "/" & vMonths(i) & "/" & sYear)
                        If Err.Number = 13 Then GoTo DateError
                        On Error GoTo 0
                        sSource = IIf(ReturnArray(k, 3) = "", sSource, ReturnArray(k, 3))
                        If sSource = "0" Then GoTo Nextk
                        sClass = IIf(ReturnArray(3, l) = "", sClass, ReturnArray(3, l))
                        sWeight = IIf(ReturnArray(4, l) = "", sWeight, ReturnArray(4, l))
                        If InStr(1, sWeight, "total value", TextCompare) > 0 Or InStr(1, sWeight, "Total  Value", TextCompare) > 0 Or InStr(1, sWeight, "Year End Billing - Revenues", TextCompare) > 0 Or InStr(1, sWeight, "Total Qty", TextCompare) > 0 Then GoTo Nextl
                        icount = ReturnArray(k, l)
                        If Not Trim(sSource) = "Totals" And Not InStr(1, ReturnArray(3, l), "Value", vbTextCompare) > 0 = "" And Not InStr(1, ReturnArray(4, l), "Total", vbTextCompare) > 0 Then
                            
                            CheckM = m
                            On Error Resume Next
                            If Err.Number = 3734 Then GoTo ErrorHandler
                            If dCount("*", "OutgoingPost", "ReportingDate = " & CDbl(ReportingDate) & " AND Source = '" & Replace(sSource, "'", "") & "' AND Class = '" & sClass & "' AND Weight = '" & sWeight & "'") = 0 Then
                                sSQL = "INSERT INTO OutgoingPost (ReportingDate, Source, Class, Weight, Count) VALUES (" & CDbl(ReportingDate) & ", '" & Replace(sSource, "'", "") & "', '" & sClass & "', '" & sWeight & "', " & icount & ");"
                                db.Execute (sSQL)
                                m = m + 1
                            ElseIf dCount("*", "OutgoingPost", "ReportingDate = " & CDbl(ReportingDate) & " AND Source = '" & Replace(sSource, "'", "") & "' AND Class = '" & sClass & "' AND Weight = '" & sWeight & "' AND Count = " & icount) = 0 Then
                                sSQL = "UPDATE OutgoingPost SET [Count] = " & icount & ";"
                                db.Execute (sSQL)
                                m = m + 1
                            End If
                            On Error GoTo 0
                            
                            sSQL = Empty
                             
                        End If
                        
                        If m >= 150 Or Loops >= 1500 Or (m > 0 And Loops > 0 And m + Loops >= 1500) Then
                            DoEvents
                            If m >= 150 Then Debug.Print "EDITS: " & Time() & ", " & ReportingDate & ", " & sSource & ", " & sClass & ", " & sWeight
                            If Loops >= 1500 Then Debug.Print "LOOPS: " & Time() & ", " & ReportingDate & ", " & sSource & ", " & sClass & ", " & sWeight
                            If m > 0 And Loops > 0 And m + Loops >= 1500 Then Debug.Print "COMBO: " & Time() & ", " & ReportingDate & ", " & sSource & ", " & sClass & ", " & sWeight
                            m = 0
                            Loops = 0
                        End If
                        If CheckM = m Then Loops = Loops + 1
    Nextl:
                    Next l
    Nextk:
                Next k
    DateError:
                On Error GoTo 0
            Next j
            wb.Close (False)
            Set wb = Nothing
        Next i
            Set appExcel = Nothing
    Exit Sub
    ErrorHandler:
        Resume
        
    End Sub


  2. #2
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    it runs slow because you are using loops.
    you should use a query that joins to date tables that accomplish the same thing.

  3. #3
    Sanguineus is offline Novice
    Windows 7 64bit Access 2016
    Join Date
    Dec 2018
    Posts
    19
    Thank you Ranman - are you able to give an example of how I could accomplish this?

  4. #4
    Minty is offline VIP
    Windows 10 Access 2016
    Join Date
    Sep 2017
    Location
    UK - Wiltshire
    Posts
    3,001
    I think to give you a proper answer we would need to see at least the following samples ;

    Your Initial starting Data
    Your Existing Data
    What resultant data you want from the above.


    The sample data provided would have to cover all possible eventualities and results.
    DLookup Syntax and others http://access.mvps.org/access/general/gen0018.htm
    Please use the star below the post to say thanks if we have helped !
    ↓↓ It's down here ↓↓

  5. #5
    Sanguineus is offline Novice
    Windows 7 64bit Access 2016
    Join Date
    Dec 2018
    Posts
    19
    Hi Minty,

    I have attached an example import workbook, for reasons that I hope are obvious there will be 12 we need to check each year (at this time we are not able to amend the structure of the workbooks )

    The data I had capture previously I have just discovered is incorrect, I'm not as yet sure why but I have deleted all data from the table so I am left with the following table structure only

    RecordID - AutoNumber
    ReportingDate - ShortDate
    Source - ShortText
    Class - ShortText
    Weight - ShortText
    Count - LongInteger

    ReportingDate, Source, Class, and Weight currently form a combined unique index

    ReportingDate is create from the sheetname, and workbook name
    Source is the department (column C)
    Class is taken from Row 3
    Weight from row 4

    Fields that contain a monetary value are irrelevant and are to be ignored (anything with the phrase Total Value or Year End within the cell)

    If the data from the workbook already matches what we have within the table we do nothing, if the entry exists but the count is different update the count, if the entry doesn't exists add it to the table.

    ideally if the workbook count is zero check to see if there is already an entry if there is remove it, if there isn't move on to the next.
    Attached Files Attached Files

  6. #6
    Sanguineus is offline Novice
    Windows 7 64bit Access 2016
    Join Date
    Dec 2018
    Posts
    19
    While it'll be really helpful to learn something new with this, I have found a solution - as I am re-importing all the data each day, my solution is to delete all previous entries from the table (within the correct limits) and re-import everything afresh skipping any 0 count entries. Means total import time for 12 sheets is 3-4 minutes as I'm only ever doing an insert now.

  7. #7
    Minty is offline VIP
    Windows 10 Access 2016
    Join Date
    Sep 2017
    Location
    UK - Wiltshire
    Posts
    3,001
    That certainly sounds like a better solution, than the "mega loops"

    I'm sure you could join the existing data and new data and a 2 stage query simply adding new, then updating any changes.
    I'm too busy at the moment to look at your samples unfortunately, but I'm sure it would work.
    DLookup Syntax and others http://access.mvps.org/access/general/gen0018.htm
    Please use the star below the post to say thanks if we have helped !
    ↓↓ It's down here ↓↓

  8. #8
    ssanfu is offline Master of Nothing
    Windows 7 32bit Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    Just curious.... looking over the code and I saw the line
    Code:
                With wb.Worksheets(Addth(j))
    What is Addth?????


    Deleted.... Brain bubble Realized at 2am that "Nextl" was a label.


    ------------------------------------------------------------------------------------------------
    Quote Originally Posted by Sanguineus View Post
    I am left with the following table structure only

    RecordID - AutoNumber
    ReportingDate - ShortDate
    Source - ShortText
    Class - ShortText
    Weight - ShortText
    Count - LongInteger
    Note that "Class" and "Count" are reserved words...
    Last edited by ssanfu; 12-13-2018 at 03:24 PM.

  9. #9
    Sanguineus is offline Novice
    Windows 7 64bit Access 2016
    Join Date
    Dec 2018
    Posts
    19
    Oh sugar really sorry forgot about that function, it simply turns the loop number into an ordinal number to match the sheet names 1 into 1st, 2 into 2nd ... 31 into 31st.

    nextl is a label to take me to the next entry if one of the prescribed conditions is met and can be found a bit further down the code, it literally just skips to the next l loop.

    thanks for the catch on the reserved words, i'll make sure they're square bracketed. I don't think it was causing an issue here as I was still getting the table populated.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 20
    Last Post: 10-13-2015, 09:05 AM
  2. Replies: 3
    Last Post: 10-16-2014, 08:49 AM
  3. Replies: 7
    Last Post: 05-28-2013, 09:11 AM
  4. Replies: 1
    Last Post: 05-04-2013, 12:19 PM
  5. Word code in Access - How to modify my current code
    By Alexandre Cote in forum Programming
    Replies: 0
    Last Post: 11-15-2010, 08:26 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums