HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Filtering and aggregating data from a multi-Worksheet Workbook

Submitted by: @import:stackexchange-codereview··
0
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 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 Function


this 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 Function


One 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 i


it 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 i


Naming 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 Long


are 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 Function
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 Function
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 i
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 i
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 Long

Context

StackExchange Code Review Q#101788, answer score: 4

Revisions (0)

No revisions yet.