Help with speeding up code that reads data from excel (1 Viewer)

wackywoo105

Registered User.
Local time
Today, 00:38
Joined
Mar 14, 2014
Messages
203
I use the following code to populate a list box with available appointments from an excel spreadsheet. The line within the spreadsheet it starts from is stored in a setting table and is updated by the code each time it runs, so it doesn’t go over past appointments. I also try to keep the excel spreadsheet short by deleting old appointments from it. I did all this to try and speed it up. Even so it still takes a while to populate the list box. I am wondering if there is anything anyone can suggest to make this process faster?

Code:
List29.RowSource = ""

Dim oXLApp As Excel.Application      'Declare the object variables
Dim oXLBook As Excel.Workbook
Dim oXLSheet As Excel.Worksheet
Set oXLApp = New Excel.Application   'Create a new instance of Excel
oXLApp.Visible = False    

If Dir(setdrive & "Appointments.xls") = "" Then
     MsgBox ("Appointments spreadsheet not found.")
     GoTo appsheetmissing
Else
     Set oXLBook = oXLApp.Workbooks.Open(setdrive & "Appointments.xls") 'Open an existing workbook
End If

Set oXLSheet = oXLBook.Worksheets(1)

Dim LastRow As Integer
    LastRow = oXLSheet.UsedRange.Rows.count + 1

Dim startline As Integer 'code to ensure always starts from correct app sheet line
Dim startlinereached As Boolean
startlinereached = False

If appsheetlength < 9 Then appsheetlength = 9
For counter = appsheetlength To LastRow ' populate listbox with available apps
If oXLSheet.Cells(counter, 1).Value >= Date Then

    If Not IsNull(oXLSheet.Cells(counter, 1).Value) And oXLSheet.Cells(counter, 2).Value <> "" And oXLSheet.Cells(counter, 3).Value = "" And oXLSheet.Cells(counter, 4).Value = "" And oXLSheet.Cells(counter, 5).Value = "" Then
        
        If oXLSheet.Cells(counter, 1).Value Like "##/##/####" Then
        If oXLSheet.Cells(counter, 2).Value Like "0.*" Then
        
        item = Format(oXLSheet.Cells(counter, 1).Value, "ddd dd/mm/yyyy") & " at " & Format(oXLSheet.Cells(counter, 2).Value, "hh:mm AM/PM")
        
        If startlinereached = False Then
          startline = counter
          startlinereached = True
        End If
        
        If oXLSheet.Cells(counter, 3).Interior.Color = RGB(192, 80, 77) Then item = item & " try to book last"

        If oXLSheet.Cells(counter, 3).Interior.Color = RGB(192, 80, 77) Then item2 = "try to book last" Else item2 = ""
        List29.AddItem (Format(oXLSheet.Cells(counter, 1).Value, "ddd dd/mm/yyyy") & ";" & Format(oXLSheet.Cells(counter, 2).Value, "hh:mm AM/PM") & ";" & item2)
      
        End If
        End If      
      
  End If
End If
Next counter

Dim sqls As String
startline = startline - 10
If startline < 9 Then startline = 9
sqls = "UPDATE [Settings] SET [AppSheetStartLine] = " & startline & " WHERE [ID] = 1;"
DoCmd.SetWarnings False
DoCmd.RunSQL sqls
DoCmd.SetWarnings True

oXLApp.DisplayAlerts = False
Set oXLSheet = Nothing
Set oXLBook = Nothing               'Disconnect from Excel (let the user take over)
oXLApp.Quit                        'Close (and disconnect from) Excel
Set oXLApp = Nothing
If (Environ$("Username")) = "admin" Then 'In win 10 excel won't close so use shell
    Call Shell("taskkill /f /im excel.exe")
End If

appsheetmissing:
 

Beetle

Duly Registered Boozer
Local time
Today, 01:38
Joined
Apr 30, 2011
Messages
1,808
Have you considered either linking the excel file as a table, or importing the excel data into a temporary table, then using queries to remove the garbage and/or select only the data you want. The only thing I see in your code that would need to be resolved is the fact that you are relying on the interior color of some of the cells to determine certain conditions, so you would need to recreate the logic that sets the cell color, rather than relying on the cell color itself, which of course wouldn't be available in this scenario.
 

Users who are viewing this thread

Top Bottom