1
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ @ThomasInzina I will be distributing this code around the office, so to avoid everyone having to go to Tools > References > Microsoft Excel Object Library 16.0 I would like anyone to be able to pick up the code and run it. I think late binding is the only way I can achieve this, what do you think? \$\endgroup\$ – Pinlop Mar 5 '18 at 18:31
  • \$\begingroup\$ You are correct. I forgot that you were referencing it from Power Point. \$\endgroup\$ – user109261 Mar 5 '18 at 20:14
  • \$\begingroup\$ @Raystafarian xlApp is declared using the New Operator. As soon as xlApp is used the VBA automatically creates a New instance of Excel.Application. \$\endgroup\$ – user109261 Mar 5 '18 at 22:11
1
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ Thank you for the extensive review! Not sure of the best way to reply, so I will do it here. Comments/Variables - I have been working on this, and will improve it more this go around. The Naming conventions I was not aware of, I thought it was just based on coding background. Will work on this. ByRef - IdentifyRolesAndScoresRows changes scoreBound/whyBound and I want it to pass that value back to the main sub, don't I use ByRef if the value is being changed? (I understand now that this should probably be a function anyway but I want to understand why this isn't right regardless) \$\endgroup\$ – Pinlop Mar 6 '18 at 16:35
  • \$\begingroup\$ Worksheet Functions - I wish I knew how to make this better. I came to this solution after posting here. If you have a fix, please post it there. Magic Numbers - Is there are general rule for when I should be making variables for constants? Data - When you run the code you wrote, does it run correctly? I compiled it here, and it's giving me variable not defined error. Even when I create the object in the main Sub, it's still giving me trouble \$\endgroup\$ – Pinlop Mar 6 '18 at 16:50
  • 1
    \$\begingroup\$ Instead of passing something byref, you can pass it byval into a function that returns its new value back to it. Byref is useful, but normally byval can manage it. Magic numbers are for when you're using something more than once, usually. But also for anytime you're using something that might seem unclear by not giving it a name. In your pastebin the first xlapp needs to be excelapplication or whatever variable you're using. The Rows reference, I'll need to look into. \$\endgroup\$ – Raystafarian Mar 6 '18 at 21:33
  • 1
    \$\begingroup\$ here is an SO question on it, you might also just try using the excel sheet information as a table, I think powerpoint knows how to handle a table. \$\endgroup\$ – Raystafarian Mar 6 '18 at 22:14
  • \$\begingroup\$ The references to "Rows", "Columns", and "Cells" are all unqualified and need to be written as "targetSheet.Rows", "targetSheet.Columns", and "targetSheet.Cells". \$\endgroup\$ – Daniel McCracken Mar 7 '18 at 20:45
0
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ Hi Daniel! Thanks a bunch for the reply. So I immediately wanted to step through your code to check how it works. I get a variable not defined error on line 85 (just like when running Raystafian's, it has to do with late-binding). Do you have any idea why this is happening? As for opening in Read-only, would this increase performance? I will do this, just want to understand the benefits. Also, now I will be doing some extensive re-coding to get the whole thing to flow better with functions and I love the idea that if I make them smaller and more granular, I'll be able to reuse these functions. \$\endgroup\$ – Pinlop Mar 6 '18 at 19:57
  • \$\begingroup\$ So I answered my own question by reading more through your code and seeing that you put -4162 instead of xlUp to avoid the Excel Object model (which still doesn't really make sense to me how this works/how to work with and around this). But the program is still stopping at getData = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value. Is this because of .Range? \$\endgroup\$ – Pinlop Mar 6 '18 at 20:28
  • \$\begingroup\$ Pretty sure it was just a typo in the original, I typed "getData" instead of "getWSData". There were a few other typos that I also had to fix, and I had to move the "toggleSettings" macro to after opening the workbook. The updated code should work. \$\endgroup\$ – Daniel McCracken Mar 6 '18 at 21:16
  • \$\begingroup\$ RE: opening in Read-only, it's just removing a possible source of failure in the code. With ReadOnly:=False, the workbook won't open if someone else has it open, and your code will fail. Opening in Read-only mode allows multiple people to access the data simultaneously, and works in your case because you just need to get the data from Excel, not modify it. Also saves you some typing (in your original code, you had to use "xlWB.Saved = True" before closing the file since changing the application settings counts as modifying the file). \$\endgroup\$ – Daniel McCracken Mar 6 '18 at 21:29
  • 1
    \$\begingroup\$ RE: avoiding the Excel object model, my wording was misleading. When you create an Excel application instance with late binding (declaring a variable with the Object type and using the CreateObject("Excel.Application") function to set the reference), you get full access to Excel's Object Model, but you don't get access to special Excel constants like xlUp or xlCalculationManual. The only way to access the constants is to use early binding. You can read about the other differences between early/late binding here: wordmvp.com/FAQs/InterDev/EarlyvsLateBinding.htm \$\endgroup\$ – Daniel McCracken Mar 6 '18 at 21:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.