Formula array vs. ADODB

MZsarko

New Member
Joined
Feb 5, 2013
Messages
7
Hello,

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:

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$ & ";"
    Else
        ' 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
        Else
            '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 = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If


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


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


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


End Sub

And this:
Code:
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, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

This:

Code:
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:
Code:
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)
            
            Sheets(strLnkSht).Activate
            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, "https://sps.mycompany.com", "\\sps.mycompany.com@SSL\DavWWWRoot")
            strPath = Replace(strPath, "/", "\")
            
            Sheets(strDstSht).Activate
            '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
Joined
Mar 18, 2010
Messages
8,787
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.
 

MZsarko

New Member
Joined
Feb 5, 2013
Messages
7
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

Threads
1,109,159
Messages
5,527,145
Members
409,749
Latest member
esmarques

This Week's Hot Topics

Top