Formula array vs. ADODB


New Member
Feb 5, 2013

I have been programming VBA for a little over a year at a department in a large enterprise and have managed to slop my way through a few projects. My main thing are Excel consolidations since I figured out how to use formula arrays to read data from closed workbooks on our SharePoint site.
Lately however I've been craving a little more speed. The first consolidation that I worked on here took an hour and a half to get one column out of 200+ workbooks. I managed to get that down to 8.5 minutes my first try and now I have it down to a minute and a half. But the minute and a half model uses data that's refreshed every hour. I would like a faster, reliable way to extract the data so I've been experimenting with ADODB.
I downloaded and tweaked the following code:

 Option Explicit

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long

    ' Create the connection string.
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
       If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1

    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then

        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If

        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    ' Clean up our Recordset object.
    Set rsData = Nothing
    Set rsCon = Nothing
    Exit Sub

    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Sub

And this:
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
    On Error GoTo 0
End Function


Function Array_Sort(ArrayList As Variant) As Variant
    Dim aCnt As Integer, bCnt As Integer
    Dim tempStr As String

    For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
        For bCnt = aCnt + 1 To UBound(ArrayList)
            If ArrayList(aCnt) > ArrayList(bCnt) Then
                tempStr = ArrayList(bCnt)
                ArrayList(bCnt) = ArrayList(aCnt)
                ArrayList(aCnt) = tempStr
            End If
        Next bCnt
    Next aCnt
    Array_Sort = ArrayList
End Function

This is the main subroutine:
Sub ADO_Test()
        Dim strPath As Variant
        Dim strLnkSht As String
        Dim strDstSht As String
        Dim rngDst As Range
        Dim cntCol As Integer
        Dim strColLetter As String
        Dim intLnkCol As Integer
        strLnkSht = "Links"
        strDstSht = "Dest"
        intLnkCol = 2
        For cntCol = 2 To Sheets(strLnkSht).Hyperlinks.Count
            strColLetter = Split(Cells(1, cntCol).Address, "$")(1)
            Set rngDst = Sheets(strDstSht).Range(strColLetter & "1:" & strColLetter & "439")
            strPath = Sheets(strLnkSht).Range(Cells(cntCol, intLnkCol), Cells(cntCol, intLnkCol)).Hyperlinks(1).Address
            strPath = Replace(strPath, "", "\\\DavWWWRoot")
            strPath = Replace(strPath, "/", "\")
            'Get the cell values and copy it in the destrange
            GetData strPath, "E-1_TR", "I25:I464", rngDst, False, False

        Next cntCol
End Sub

This code reads through a column of hyperlinks, changes the address to a DAV link and reads the column into a recordset and (just so I can see the data) copies it into a sheet.
I can get data using this and it also has the advantage of being able to be stored and manipulated in memory. A formula array has to go on a sheet and then be read into an array. However ADODB seems to be very slow. Is there any way this code can be optimized for speed or is that just the way it is with ADODB?

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Jerry Sullivan

MrExcel MVP
Mar 18, 2010
Hi MZarlo,

Optimizing your process will depend on factors like the size of your files, the speed of your access to the SharePoint site and how frequently the files are actually modified. You noted that they are refreshed every hour however it's not clear whether all 200 of your files change within that period or just a subset.

That being said, here's a few ideas to explore...

Does the version of SharePoint you are using have the Sync feature that allows you to Sync the files on your SharePoint site with a local copy on your computer?

If so, you could try doing that and consolidating your files locally to see if that is faster.

If only some of your 200 files change hourly, you might improve performance by only updating the data in your consolidation file for those source files that have been modified.

If your list of hyperlinked files doesn't change often, you could explore using query tables that store your queries and can simply be refreshed instead of rebuilding the queries each time your process is run.


New Member
Feb 5, 2013
Thanks for the direction, Jerry. I thought about a local consolidation. I'll give that a try.
BTW, I'm in SD too.:)

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics