patternMinor
Filtering and aggregating data from a multi-Worksheet Workbook
Viewed 0 times
multiworkbookaggregatingworksheetandfromdatafiltering
Problem
First off, this is version 2 of a previous question about the same macro: Previous Version. Thank you to Raystafarian, RubberDuck and everyone in chat who helped me make it better.
The Macro accesses a workbook containing 8 worksheets each with similarly structured but not identical tables of data (submitted business for my company). It then filters this data for desired columns and aggregates it into a separate workbook.
As before, I'd like advice/feedback on improving the following:
-
Readability: Ability for somebody who is not me to come in blind, and (relatively) easily figure out how the whole thing works and fix
some problem that's cropped up.
-
Robustness: Designing subs/functions to deal with variable cases and/or to reliably fail when given unintended arguments.
-
Reusability: Designing subs/functions/the entire project so they can be easily re-purposed for future projects.
What Changed: The order in which the Macro does things is roughly the same, but almost everything else was entirely re-written / re-factored from scratch.
Bugs Found: The
File Download if Desired
Module 1: "M1_Public_Variables_Constants"
```
Option Explicit
'/ Workbooks
Public WbSubsheet As Workbook '/ Contains all Lumin Wealth submitted Business
Public WbAdviserReport As Workbook '/ Will Contain an aggregation of the subsheet and a submission report (by month) for each adviser
'/ Adviser Report worksheets
Public WsAggregatedData As Worksheet '/ Will contain the aggregated subsheet data
Public WsAdviserReport As Worksheet '/ Will contain the submissions report, reported
The Macro accesses a workbook containing 8 worksheets each with similarly structured but not identical tables of data (submitted business for my company). It then filters this data for desired columns and aggregates it into a separate workbook.
As before, I'd like advice/feedback on improving the following:
-
Readability: Ability for somebody who is not me to come in blind, and (relatively) easily figure out how the whole thing works and fix
some problem that's cropped up.
-
Robustness: Designing subs/functions to deal with variable cases and/or to reliably fail when given unintended arguments.
-
Reusability: Designing subs/functions/the entire project so they can be easily re-purposed for future projects.
What Changed: The order in which the Macro does things is roughly the same, but almost everything else was entirely re-written / re-factored from scratch.
Bugs Found: The
public sub ErrorMessage calls RestoreApplicationSettings but doesn't have the variables it's trying to pass as arguments. These 3 arguments varScreenUpdating, varEnableEvents, varCalculation have been made Public variables and moved to the Public Variable Module.File Download if Desired
Module 1: "M1_Public_Variables_Constants"
```
Option Explicit
'/ Workbooks
Public WbSubsheet As Workbook '/ Contains all Lumin Wealth submitted Business
Public WbAdviserReport As Workbook '/ Will Contain an aggregation of the subsheet and a submission report (by month) for each adviser
'/ Adviser Report worksheets
Public WsAggregatedData As Worksheet '/ Will contain the aggregated subsheet data
Public WsAdviserReport As Worksheet '/ Will contain the submissions report, reported
Solution
Public Function IsWorkbookOpen(ByVal strTargetName As String) As Boolean
On Error Resume Next
Workbooks(strTargetName).Activate
If ActiveWorkbook.Name <> strTargetName _
Then
IsWorkbookOpen = False
Else
IsWorkbookOpen = True
End If
On Error GoTo 0
End Functionthis can be simplified by just returning the condition like so
Public Function IsWorkbookOpen(ByVal strTargetName As String) As Boolean
On Error Resume Next
Workbooks(strTargetName).Activate
IsWorkbookOpen = (ActiveWorkbook.Name = strTargetName)
On Error GoTo 0
End FunctionOne of the many times your indentation is going strange
lngFirstRow = rngTopLeftCell.Row
lngFirstColumn = rngTopLeftCell.Column
lngFinalRow = Cells(LngFinalCellRow, lngFirstColumn).End(xlUp).Row
lngFinalColumn = Cells(lngFirstRow, LngFinalCellColumn).End(xlToLeft).Column
ReDim arrCurrentArray(0 To lngFinalRow - lngFirstRow + 1, 0 To lngFinalColumn - lngFirstColumn + 1)
arrCurrentArray(0, 0) = wsCurrentWorksheet.Name
For i = lngFirstRow To lngFinalRow
For j = lngFirstColumn To lngFinalColumn
arrCurrentArray(i - lngFirstRow + 1, j - lngFirstColumn + 1) = wsCurrentWorksheet.Cells(i, j)
Next j
Next iit is easier to read (IMHO) by keeping the horizontal spacing at the expected level like so
lngFirstRow = rngTopLeftCell.Row
lngFirstColumn = rngTopLeftCell.Column
lngFinalRow = Cells(LngFinalCellRow, lngFirstColumn).End(xlUp).Row
lngFinalColumn = Cells(lngFirstRow, LngFinalCellColumn).End(xlToLeft).Column
ReDim arrCurrentArray(0 To lngFinalRow - lngFirstRow + 1, 0 To lngFinalColumn - lngFirstColumn + 1)
arrCurrentArray(0, 0) = wsCurrentWorksheet.Name
For i = lngFirstRow To lngFinalRow
For j = lngFirstColumn To lngFinalColumn
arrCurrentArray(i - lngFirstRow + 1, j - lngFirstColumn + 1) = wsCurrentWorksheet.Cells(i, j)
Next j
Next iNaming is a very important task which should be done properly. Names like
InitialiseStuff() doesn't tell Sam the maintainer(or you in 6 months) what it is about. I encourage you to spend some time in renaming some (a lot) of your methods and variables names. These names should be as descriptive and meaningful as possible. You tend to use the variables type in the variables names, which in VBA is understandable, but sometimes you are going overboard by doing so like for instance
arrCurrentArray. Declarations like this
Dim bErrorFound As Boolean
Dim colMissingSheetHeadings As Collection '/ For each sheet, contains the headings that shouldn't be there
Dim strException As String '/ holds string items from colMissingSheetHeadings
Dim strErrorMessage As String
Dim i As Long
Dim j As Long
Dim k As Longare nice to read but a hell to maintain. Consider you change a variables name so it wouldn't fit anymore into this format because it is getting too long, you would need to adjust each other declaration too.
An
if condition evaluates to a boolean value which is either true or false. So a if statement like so If bErrorFound = True Then Call ErrorMessage(strErrorMessage)could be simplified to
If bErrorFound Then Call ErrorMessage(strErrorMessage)Code Snippets
Public Function IsWorkbookOpen(ByVal strTargetName As String) As Boolean
On Error Resume Next
Workbooks(strTargetName).Activate
If ActiveWorkbook.Name <> strTargetName _
Then
IsWorkbookOpen = False
Else
IsWorkbookOpen = True
End If
On Error GoTo 0
End FunctionPublic Function IsWorkbookOpen(ByVal strTargetName As String) As Boolean
On Error Resume Next
Workbooks(strTargetName).Activate
IsWorkbookOpen = (ActiveWorkbook.Name = strTargetName)
On Error GoTo 0
End FunctionlngFirstRow = rngTopLeftCell.Row
lngFirstColumn = rngTopLeftCell.Column
lngFinalRow = Cells(LngFinalCellRow, lngFirstColumn).End(xlUp).Row
lngFinalColumn = Cells(lngFirstRow, LngFinalCellColumn).End(xlToLeft).Column
ReDim arrCurrentArray(0 To lngFinalRow - lngFirstRow + 1, 0 To lngFinalColumn - lngFirstColumn + 1)
arrCurrentArray(0, 0) = wsCurrentWorksheet.Name
For i = lngFirstRow To lngFinalRow
For j = lngFirstColumn To lngFinalColumn
arrCurrentArray(i - lngFirstRow + 1, j - lngFirstColumn + 1) = wsCurrentWorksheet.Cells(i, j)
Next j
Next ilngFirstRow = rngTopLeftCell.Row
lngFirstColumn = rngTopLeftCell.Column
lngFinalRow = Cells(LngFinalCellRow, lngFirstColumn).End(xlUp).Row
lngFinalColumn = Cells(lngFirstRow, LngFinalCellColumn).End(xlToLeft).Column
ReDim arrCurrentArray(0 To lngFinalRow - lngFirstRow + 1, 0 To lngFinalColumn - lngFirstColumn + 1)
arrCurrentArray(0, 0) = wsCurrentWorksheet.Name
For i = lngFirstRow To lngFinalRow
For j = lngFirstColumn To lngFinalColumn
arrCurrentArray(i - lngFirstRow + 1, j - lngFirstColumn + 1) = wsCurrentWorksheet.Cells(i, j)
Next j
Next iDim bErrorFound As Boolean
Dim colMissingSheetHeadings As Collection '/ For each sheet, contains the headings that shouldn't be there
Dim strException As String '/ holds string items from colMissingSheetHeadings
Dim strErrorMessage As String
Dim i As Long
Dim j As Long
Dim k As LongContext
StackExchange Code Review Q#101788, answer score: 4
Revisions (0)
No revisions yet.