I finished the first part of my code that is run from PowerPoint. The steps it takes are:
- Open Excel file specified
- Choose correct tab that has an existing
- Identify size of dataset and store into
- Copy each cell into an array
IQRngRefand each cell in the top row into
- On column A, identify the row numbers (
whyBound) and values in between rows containing the words “Score” and “Why?” (
- 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
First, you’re right it won’t work without the proper reference enabled, but that’s later.
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.
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
whyBoundwith the name? Not much.
- I’m not sure what
IQis, but we can probably let that one slide on format because of what it may be. But, what’s an
rowNumbwould be better with two additional letters, which are free to use!
colNumberor even better yet
iColare you iterating through something? Sounds like a
- You get the idea,
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.
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
Functions should be used when something is returned and subs should be used when something happens.
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
Excel.Application. Once you have your
xlApp, use it all the time.
Excel.Application.Index(IQRngRef(0), Evaluate("ROW(" & scoreBound & ":" & whyBound & ")"))
There’s got to be a better way, right?
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
Grab Some Data
You say you need to grab some data from Excel, so grab some data. All at once.
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