Open Excel, grab information, store it locally and close Excel

By Posted on

Problem

I finished the first part of my code that is run from PowerPoint. The steps it takes are:

  1. Open Excel file specified
  2. Choose correct tab that has an existing PivotTable
  3. Identify size of dataset and store into colNumb and rowNumb
  4. Copy each cell into an array IQRngRef and each cell in the top row into IQRef
  5. On column A, identify the row numbers (scoreBound/whyBound) and values in between rows containing the words “Score” and “Why?” (roleArray)
  6. Return all of this data into the main sub, so that it can be stored locally and to be used in PowerPoint and close Excel before doing so.

Everything works as expected, but I want to post here to see if there are any adjustments people with more experience than I would make.

One clear adjustment I think I’ll have to tackle is late binding. I haven’t learned how to work with late binding completely yet, so I’ve been putting this part off. From what I understand, all I have to do is create the Excel object and re define all my variables accordingly. But I also understand that some of the functions I used in this code might not be accessible without fully downloading the entire Excel library, and that’s the part I’m scared of. Any help here would be much appreciated.

Another question I have is if it’s ok to be passing as many variables through different sub as is seen here:

CaptureExcelReferences xlWB, xlApp, pivotSheetName, IQRef, IQRngRef, roleArray, scoreBound, whyBound

Option Explicit
    Public Sub createTableArray()
        '-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
        '~Input file path here in between the quotation marks
        Dim testFilePath As String
        testFilePath = "C:file.xlsx"

        '~Input name of Sheet with Pivot Tables here in between the quotation marks
        Dim pivotSheetName As String
        pivotSheetName = "IQ_Pivot"
        '-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

        'Timer start
        Dim StartTime As Double
        StartTime = Timer

        Excel.Application.ScreenUpdating = False
        Excel.Application.EnableEvents = False
        Excel.Application.DisplayAlerts = False

        Dim xlApp As Excel.Application
        Set xlApp = New Excel.Application
        'xlApp.Visible = True 'Make Excel visible
        Dim xlWB As Excel.Workbook
        On Error GoTo fileRetrieveError
        Set xlWB = xlApp.Workbooks.Open(testFilePath, True, False, , , , True, Notify:=False)
        If xlWB Is Nothing Then
fileRetrieveError:
            MsgBox ("Error")
            Exit Sub
        End If

        Dim IQRef() As Variant
        Dim IQRngRef() As Variant
        Dim roleArray As Variant
        Dim scoreBound As Long
        Dim whyBound As Long
        CaptureExcelReferences xlWB, xlApp, pivotSheetName, IQRef, IQRngRef, roleArray, scoreBound, whyBound

        xlApp.Application.ScreenUpdating = True
        xlApp.Application.EnableEvents = True
        xlApp.DisplayAlerts = True

        xlWB.Saved = True
        xlWB.Close
        Set xlWB = Nothing
        xlApp.Quit
        Set xlApp = Nothing

        'End Timer
        Dim SecondsElapsed As Double
        SecondsElapsed = Round(Timer - StartTime, 2)
        MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
    End Sub

    Private Sub CaptureExcelReferences(ByVal xlWB As Workbook, ByVal xlApp As Excel.Application, ByVal pivotSheetName As String, ByRef IQRef() As Variant, ByRef IQRngRef() As Variant, ByRef roleArray As Variant, ByRef scoreBound As Long, ByRef whyBound As Long)
        Dim ShRef As Excel.Worksheet
        Set ShRef = xlWB.Worksheets(pivotSheetName)
        Dim colNumb As Long
        colNumb = ShRef.Cells(1, ShRef.Columns.Count).End(xlToLeft).Column
        ReDim IQRef(colNumb)
        ReDim IQRngRef(colNumb)
        Dim rowNumb As Long
        rowNumb = ShRef.Cells(ShRef.Rows.Count, 1).End(xlUp).Row
        CaptureIQRefsLocally ShRef, xlApp, rowNumb, colNumb, IQRef, IQRngRef
        IdentifyRolesAndScoresRows IQRngRef, rowNumb, roleArray, scoreBound, whyBound
    End Sub

    Private Sub CaptureIQRefsLocally(ByVal ShRef As Worksheet, ByVal xlApp As Excel.Application, ByVal rowNumb As Long, ByVal colNumb As Long, ByRef IQRef As Variant, ByRef IQRngRef As Variant)
        'capture IQ references in arrays. Values for column titles in IQRef and full column Ranges in IQRngRef.
        Dim iCol As Long
        Dim alignIQNumbToArrayNumb
        For iCol = 1 To colNumb
            alignIQNumbToArrayNumb = iCol - 1
            IQRngRef(alignIQNumbToArrayNumb) = xlApp.Transpose(ShRef.Range(ShRef.Cells(1, iCol), ShRef.Cells(rowNumb, iCol)).Value)
            IQRef(alignIQNumbToArrayNumb) = ShRef.Cells(1, iCol).Value
        Next iCol
    End Sub

    Private Sub IdentifyRolesAndScoresRows(ByRef IQRngRef As Variant, ByVal rowNumb As Long, ByRef roleArray As Variant, ByRef scoreBound As Long, ByRef whyBound As Long)
        'Figure out what rows in the array contain the information needed.
        scoreBound = Excel.Application.Match("Score", IQRngRef(0), 0) + 1
        whyBound = Excel.Application.Match("Why?", IQRngRef(0), 0) - 1
        roleArray = Excel.Application.Index(IQRngRef(0), Evaluate("ROW(" & scoreBound & ":" & whyBound & ")"))
    End Sub

Solution

First, you’re right it won’t work without the proper reference enabled, but that’s later.

Comments

Comments – “code tell you how, comments tell you why”. The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you’re doing something rather than how you’re doing it. Here are a few reasons to avoid comments all together.

Variables

There are Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names. You also want to give your variables meaningful names.

Dim StartTime As Double
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim IQRef() As Variant
Dim IQRngRef() As Variant
Dim roleArray As Variant
Dim scoreBound As Long
Dim whyBound As Long
Dim ShRef As Excel.Worksheet
Dim colNumb As Long
Dim rowNumb As Long
Dim iCol As Long
Dim alignIQNumbToArrayNumb
ByVal xlWB As Workbook, ByVal xlApp As Excel.Application, ByVal 
pivotSheetName As String, ByRef IQRef() As Variant, ByRef IQRngRef()
As Variant, ByRef roleArray As Variant, ByRef scoreBound As Long,
ByRef whyBound As Long)
ByVal ShRef As Worksheet, ByVal xlApp As Excel.Application, ByVal rowNumb 
As Long, ByVal colNumb As Long, ByRef IQRef As Variant, ByRef
IQRngRef As Variant)
ByRef IQRngRef As Variant, ByVal rowNumb As Long, ByRef roleArray As 
Variant, ByRef scoreBound As Long, ByRef whyBound As Long)
  • What can I tell about whyBound with the name? Not much.
  • I’m not sure what IQ is, but we can probably let that one slide on format because of what it may be. But, what’s an IQRef or an IQRngRef (both variants)?
  • colNumb and rowNumb would be better with two additional letters, which are free to use! colNumber or even better yet columnNumber or columnIndex.
  • iCol are you iterating through something? Sounds like a targetColumn or columnIndex
  • You get the idea, ShRef is the targetSheet right?

Dim alignIQNumbToArrayNumb You didn’t give this a type. Why not?

    Dim testFilePath As String
    testFilePath = "C:file.xlsx"
    Dim pivotSheetName As String
    pivotSheetName = "IQ_Pivot"

These look like they could be constants

 Const FILE_PATH as String = "C:file.xlsx"
 Const PIVOT_SHEET_NAME as String = "IQ_Pivot"

You could probably put those constants outside of any routine so that they are available to the entire module and you won’t need to pass them to functions.

ByRef

If possible, you should pass arguments ByVal rather than ByRef. I know sometimes it makes more sense to use the reference, but I don’t quite see why a Long would need to be a reference.

Also, passing so many arguments ByRef leads me to believe that you should be using some Functions instead of Subs.

Functions should be used when something is returned and subs should be used when something happens.

Worksheet functions

Why –

xlApp.Transpose(
Excel.Application.Match( 
Excel.Application.Index(

You want to avoid using the Excel Object Model, so why rely on excel functions? Also, you’ve been a little inconsistent there, using xlApp and Excel.Application. Once you have your xlApp, use it all the time.

Also, an Evaluate?

Excel.Application.Index(IQRngRef(0), Evaluate("ROW(" & scoreBound & ":" & whyBound & ")"))

There’s got to be a better way, right?

Magic Numbers

I see you’ve used 1 a bunch with columns. Might as well make that a global constant

Const FIRST_COLUMN as Long = 1

You also have some 0s

IQRngRef(0), 0)

Grab Some Data

You say you need to grab some data from Excel, so grab some data. All at once.

Something like

    Dim targetLastRow As Long
    Dim targetLastColumn As Long
    targetLastRow = targetsheet.Cells(Rows.Count, 1).End(xlUp).Row
    targetLastColumn = targetsheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim myDataFromExcel As Variant
    myDataFromExcel = targetsheet.Range(Cells(1, 1), Cells(targetLastRow, targetLastColumn))

BAM now close excel and you have your data in powerpoint. Save a lot of hassle, right? And we’ll use late binding

    Dim excelApplication As Object
    Set excelApplication = CreateObject("Excel.Application")
    Dim arrayOfData As Variant
    arrayOfData = GetData(excelApplication)
    excelApplication.DisplayAlerts = False
    excelApplication.Quit

Private Function GetData(ByVal excelApp As Object) As Variant
    Dim targetBook As Object
    Set targetBook = excelApp.Workbooks.Open(FILE_PATH)
    Dim targetSheet As Object
    Set targetSheet = targetBook.Sheets(PIVOT_SHEET_NAME)
    Dim targetLastRow As Long
    Dim targetLastColumn As Long
    targetLastRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row
    targetLastColumn = targetSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    GetData = targetSheet.Range(Cells(1, 1), Cells(targetLastRow, targetLastColumn))
End Function

Now we have all that data out of excel and in powerpoint, we’ve closed excel and we can do anything we want with the data, in powerpoinit.

Honestly, I’m not even sure why I passed the excelApplication to the function, you might as well just create the object there and close the object there. Especially since you have those global constants, right?

Working with your data

Now you can create as many arrays from your array as you wish, or you can do everything with that single array.

Dim scoreArray As Variant
scoreArray = GetScores(arrayOfData)

Private Function GetScores(ByVal arrayOfData As Variant) As Variant
    Const SEARCH_SCORE As String = "Score"
    Dim scoreIndex As Long
    scoreIndex = 1
    Dim scoreRows As Variant
    Dim index As Long
    For index = LBound(arrayOfData) To UBound(arrayOfData)
         If arrayOfData(index) = SEARCH_SCORE Then
              ReDim Preserve scoreRows(scoreIndex)
              scoreRows(scoreIndex) = arrayOfData(index)
              scoreIndex = scoreIndex + 1
         End If
    Next
End Function

Or something similar, I don’t think this is exactly what you’re doing, but you get the idea.

The main thing I’d recommend is separating the functionality of the program into discrete, single-purpose units. Try to make those as general as possible, so you can reuse them in the future. I was able to capture the majority of your program’s functionality with 7-8 functions/subs, all of which could potentially be reused– with little or no modification– in future projects.

Some other things I noticed:

  • You’re not actually modifying the workbook, so you should probably just open it as read-only
  • As Raystafarian mentioned, you should consider returning values/objects with Functions instead of passing references ByRef to Subs and modifying them
  • As Raystafarian also mentioned, you’re much better off filling arrays all at once instead of cell-by cell

Here’s how I’d have written the program to maximize flexibility/reusability (EDIT: corrected some typos that were causing issues): 

Option Explicit
Sub mainThing()

    'Input file path and name of sheet containing pivot tables
    Dim testFilePath As String
    Dim pivotSheetName As String
    testFilePath = "C:file.xlsx"
    pivotSheetName = "IQ_Pivot"

    'Get raw excel data
    Dim rawExcelData As Variant
    rawExcelData = extractExcelData(testFilePath, pivotSheetName)

    'Extract headers
    Dim headerArr As Variant
    headerArr = getHeaders(rawExcelData)

    'Extract score data
    Dim scoreArr As Variant
    scoreArr = extractRows(rawExcelData, "Score", "Why?", 1)

    'Do whatever else you want to in powerpoint


End Sub
Function extractExcelData(fPath As String, sheetName As String) As Variant
'Gets data from a single sheet (sheetName) of an Excel file (fPath) and returns as an array

    'Create Excel application
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")

    'Open workbook, or display error if workbook could not be open
    'Optimize Excel calculation/visual settings
    Dim xlWB As Object
    Set xlWB = getWorkbook(xlApp, fPath)                             
    If xlWB Is Nothing Then
        xlApp.Quit
        Set xlApp = Nothing
        MsgBox ("Error: Could not open " & fPath)
        Exit Function
    End If
    Call toggleSettings(xlApp, False)

    'Get data from worksheet and close workbook
    Dim excelData As Variant
    excelData = getWSData(xlWB, sheetName)
    xlWB.Close
    Set xlWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing

    extractExcelData = excelData

End Function
Function getWSData(ByRef xlWB As Object, ByVal wsName As String) As Variant
'Returns array of data from a worksheet (wsName) in a workbook (xlWB)

    Dim ws As Object
    Set ws = xlWB.Sheets(wsName)

    Dim lastRow As Long
    Dim lastCol As Long
    lastRow = getLastRow(ws)
    lastCol = getLastColumn(ws)
    getWSData = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value

End Function
Function getLastRow(ws As Object, Optional colNum As Long = 1) As Long

    'Hard codes reference to xlUp (-4162) in case project uses late binding
    getLastRow = ws.Cells(ws.Rows.Count, colNum).End(-4162).Row

End Function
Function getLastColumn(ws As Object, Optional rowNum As Long = 1) As Long

    'Hard codes reference to xlToLeft (-4159) in case project uses late binding
    getLastColumn = ws.Cells(rowNum, ws.Columns.Count).End(-4159).Column

End Function
Sub toggleSettings(xlApp As Object, turnOn As Boolean, Optional manualCalc As Boolean = False)
'Toggles various excel application settings to improve performance
'Hard codes references to xlCalculationManual (-4135) and xlCalculationAutomatic (-4105) in case project uses late binding      

    With xlApp
        If manualCalc Then
            .Calculation = -4135
            .CalculateBeforeSave = False
        Else
            .Calculation = IIf(turnOn, -4105, -4135)
            .CalculateBeforeSave = turnOn
        End If
        .DisplayAlerts = turnOn
        .AskToUpdateLinks = turnOn
        .DisplayStatusBar = turnOn
        .ScreenUpdating = turnOn
        .EnableAnimations = turnOn
    End With

End Sub
Function getWorkbook(xlApp As Object, fileName As String, Optional asReadOnly As Boolean = True) As Object
'Return Excel workbook object, or nothing if file can't be opened

    On Error Resume Next
    Set getWorkbook = xlApp.Workbooks.Open(FileName:=fileName, _
                                           UpdateLinks:=True, _
                                           ReadOnly:=asReadOnly, _
                                           Notify:=False)
    On Error GoTo 0

End Function
Function getHeaders(arr As Variant) As Variant
'Extracts first row from an array

    ReDim dataHeaders(LBound(arr, 2) To UBound(arr, 2)) As Variant
    Dim i As Long
    For i = LBound(dataHeaders) To UBound(dataHeaders)
        dataHeaders(i) = arr(LBound(arr, 1), i)
    Next

    getHeaders = dataHeaders

End Function
Function extractRows(arr As Variant, startIndicator As String, endIndicator As String, Optional colNum As Long = 1, Optional includeIndicatorRows As Boolean = False) As Variant
'Extracts rows from a 2d array by searching for a start and end indicator in a column (colNum) of the array
'Returned array contains all rows between the indicator rows
'If includeIndicatorRows is True, returned array also includes the indicator rows

    Dim i As Long
    Dim j As Long
    Dim x As Long

    'Find start/end array row for data extraction
    Dim startRow As Long
    Dim endRow As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, colNum) = startIndicator Then
            startRow = i + IIf(includeIndicatorRows, 0, 1)
        ElseIf arr(i, colNum) = endIndicator Then
            endRow = i - IIf(includeIndicatorRows, 0, 1)
            Exit For
        End If
    Next

    If startRow > endRow Then
        Exit Function
    End If

    'Fill new array with identified rows
    Dim numCols As Long
    Dim numRows As Long
    numCols = UBound(arr, 2)
    numRows = endRow - startRow + 1
    ReDim extractedData(1 To numRows, 1 To numCols) As Variant
    x = 1
    For i = startRow To endRow
        For j = 1 To numCols
            extractedData(x, j) = arr(i, j)
        Next
        x = x + 1
    Next

    extractRows = extractedData

End Function

Leave a Reply

Your email address will not be published. Required fields are marked *