VBA execution speed differs between Excel and Access - excel

Question

I have an Excel file with around 70-80 columns. I need to get the min and max values for each columns. I also need the min and max values on Access. I wrote the code both for Access and Excel and the speed of the macro is very different in both. Both are a little different but very similar.
Here is the Excel code :
Public Sub MinAndMax()
Dim i As Long, j As Long
Dim usedTime As Double
usedTime = Timer
Dim nbCol As Long, nbRow As Long
nbCol = Range("A1").End(xlToRight).Column
nbRow = Range("A1").End(xlDown).Row
Dim min As Double, max As Double
Dim temp As Variant
'First column is for the table key
'First row is for table header
For j = 2 To nbCol
min = Cells(2, j)
max = Cells(2, j)
For i = 3 To nbRow
temp = Cells(i, j)
If IsNumeric(temp) Then
If temp > max Then max = temp
If temp < max Then min = temp
End If
Next i
Next j
MsgBox "Time : " Round(Timer - duree) " seconds."
End Sub
This takes approximatively 5 seconds on Excel.
On Access, it's now a function returning an array, with an option indicating if you want the array with the max or min for each columns. So in order to get both min and max, I have to call it twice.
Private Function GetMinAndMax_Access(Optional ByVal getMin As Boolean = False) As Double()
Dim Path As String
Path = "C:\File.xlsx"
Dim appExcel As Excel.Application
Set appExcel = CreateObject("Excel.Application")
appExcel.ScreenUpdating = False
Dim wb As Workbook
Set wb = appExcel.Workbooks.Open(Path)
Dim ws As Worksheet
Set ws = wb.Worksheets(1)
Dim nbCol As Long, nbRow As Long
nbCol = ws.Range("A1").End(xlToRight).Column
nbRow = ws.Range("A1").End(xlDown).Row
ReDim extremum(2 To nbCol) As Double
Dim temp As Variant
Dim i As Long, j As Long 'Again, data start at row 2, column 2
For j = 2 To nbCol
extremum(j) = ws.Cells(2, j)
For i = 3 To nbRow
temp = ws.Cells(i, j)
If IsNumeric(temp) Then
If getMin Then
If temp < extremum(j) Then extremum(j) = temp
Else
If temp > extremum(j) Then extremum(j) = temp
End If
End If
Next i
Next j
GetMinAndMax_Access = extremum
appExcel.ScreenUpdating = True
wb.Close SaveChanges:=False
appExcel.Quit
End Function
This took precisely 29 minutes to perform on the same dataset. Note that I called the function twice, once for min values and once for max ones.
Any idea why the speeds are so different between Access and Excel, and what can be done about that ? It seems really weird to me !

Answer 1

Seems like a bit of a long winded way to get the minimum and maximum numeric values from the columns. The worksheet functions MIN and MAX are pretty fast at doing it so:
In Excel:
Public Sub MinAndMax()
Dim rLastCell As Range
Dim x As Long
Dim colMinMax As Collection
Set rLastCell = Cells.Find(What:="*", After:=Cells(1, 1), SearchDirection:=xlPrevious)
If Not rLastCell Is Nothing Then
Set colMinMax = New Collection
For x = 1 To rLastCell.Column
colMinMax.Add Array(Application.WorksheetFunction.min(Columns(x)), _
Application.WorksheetFunction.max(Columns(x)))
Next x
End If
End Sub
In Access (with late binding so no need to set references):
Sub ToUse()
Dim MyCol As Collection
Set MyCol = New Collection
Set MyCol = GetMinMax("C:\Documents and Settings\crladmin.ADMINNOT\My Documents\MinMax.xlsm", "Sheet1")
End Sub
Private Function GetMinMax(sPath As String, sSheet As String) As Collection
Dim oXL As Object
Dim oWB As Object
Dim oWS As Object
Dim rLastCell As Object
Dim x As Long
Dim colMinMax As Collection
Set oXL = CreateXL
Set oWB = oXL.Workbooks.Open(sPath, False)
Set oWS = oWB.Worksheets(sSheet)
Set rLastCell = oWS.Cells.Find(What:="*", After:=oWS.Cells(1, 1), SearchDirection:=2) '2 = xlPrevious
If Not rLastCell Is Nothing Then
Set colMinMax = New Collection
For x = 1 To rLastCell.Column
colMinMax.Add Array(oXL.WorksheetFunction.min(oWS.Columns(x)), _
oXL.WorksheetFunction.max(oWS.Columns(x)))
Next x
End If
End Function
Public Function CreateXL(Optional bVisible As Boolean = True) As Object
Dim oTmpXL As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Defer error trapping in case Excel is not running. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Set oTmpXL = GetObject(, "Excel.Application")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If an error occurs then create an instance of Excel. '
'Reinstate error handling. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ERROR_HANDLER
Set oTmpXL = CreateObject("Excel.Application")
End If
oTmpXL.Visible = bVisible
Set CreateXL = oTmpXL
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure CreateXL."
Err.Clear
End Select
End Function
Both procedures will return collections with 2D arrays containing MIN & MAX values for each column:
Item 1(0) - 4
Item 1(1) - 98
Item 2(0) - 3
Item 2(1) - 15