11
\$\begingroup\$

Since I learnt about refactoring, I've been busy creating my own Module of Standard Methods. I feel it's about time they got a review of their own.

Open to all aspects of advice but particularly interested in:

Method Naming:
Are they completely unambiguous about what the method does/returns?

Use of Optional / Variable parameters:
Always a tricky balance to define the scope of a method and its potential uses. Just after general opinions.

Redundancy:
Have I ended up re-inventing the wheel anywhere?

Good use of Sub/Function:
Is there a sub that should be a function, or vice versa?

Further Refactoring:
Any general improvements to the methods described / other ways to achieve the same outcomes.

N.B. I know I have separate subs/functions with different dimensions of array. I haven't yet decided if I prefer it this way or if I want to make generalised methods that determine array size and then operate on them. If you have a compelling case 1 way or the other, I'd be interested to hear it.

Positive feedback is also appreciated :)

Methods:

1) Purpose: Activate/Open Workbook

Public Sub GetWorkbook(ByVal strFilename As String, ByVal strFilePath As String)

    Dim bWbIsOpen As Boolean

    bWbIsOpen = WorkbookIsOpen(strFilename)
    If Not bWbIsOpen Then Workbooks.Open strFilePath & strFilename

End Sub

2) Return Value: Boolean, Is the specified Workbook currently open?

Public Function WorkbookIsOpen(ByVal strTargetName As String) As Boolean

    Dim wbTest As Workbook

        On Error Resume Next

            Set wbTest = Workbooks(strTargetName)

            WorkbookIsOpen = (wbTest.Name = strTargetName)

        On Error GoTo 0

End Function

3) Purpose: Get a Table of Data from a Worksheet into an Array. [option] specify a string identifier of the TopLeftCell and a range within which to search for it.

Public Sub PutSheetDataInArray(ByRef wbCurrent As Workbook, ByRef wsCurrent As Worksheet, ByRef arrCurrentArray As Variant, Optional ByVal strTopLeftCellIdentifier As Variant, _
Optional ByVal lngStartRow As Long = 1, Optional ByVal lngEndRow as Variant, _
Optional ByVal lngStartColumn As Long = 1, Optional ByVal lngEndColumn as Variant)
    '/======================================================================================================================================================
    Dim i As Long, j As Long, k As Long

    Dim rngTopLeftCell  As Range
    Dim rngSearchRange  As Range

    Dim strErrorMessage As String

    Dim arrHiddenColumns    As Variant
        arrHiddenColumns = Array()

    Dim arrHiddenRows   As Variant
        arrHiddenRows = Array()

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    '/======================================================================================================================================================
        wbCurrent.Activate
        wsCurrent.Activate

        If IsMissing(strTopLeftCellIdentifier) _
            Then
                Set rngTopLeftCell = Cells(1, 1)
            ElseIf TypeName(strTopLeftCellIdentifier) = "String" _
                Then
                    If IsMissing(lngEndRow) Then lngEndRow = wsCurrent.Rows.Count
                    If IsMissing(lngEndColumn) Then lngEndColumn = wsCurrent.Columns.Count

                    Set rngSearchRange = wsCurrent.Range(Cells(lngStartRow, lngStartColumn), Cells(lngEndRow, lngEndColumn))
                    Set rngTopLeftCell = CellContainingStringInRange(rngSearchRange, strTopLeftCellIdentifier)
                Else
                    strErrorMessage = "strTopLeftCellIdentifier must be a string, not a " & TypeName(strTopLeftCellIdentifier)
                    ErrorMessage (strErrorMessage)
        End If


        LB1 = rngTopLeftCell.Row
        LB2 = rngTopLeftCell.Column
        AssignRangeBoundsOfData rngTopLeftCell, UB1:=UB1, UB2:=UB2

        RecordHiddenRowsAndUnhide arrHiddenRows, LB1, UB1
        RecordHiddenColumnsAndUnhide arrHiddenColumns, LB2, UB2

            WriteRangeToArrayIteratively wsCurrent, arrCurrentArray, LB1, UB1, LB2, UB2

        HideRows arrHiddenRows
        HideColumns arrHiddenColumns

End Sub

4) Return Value: Range, Cell in Range containing the specified Value. Else calls an error message.

Public Function CellContainingStringInRange(ByRef rngSearch As Range, ByVal strSearch As String) As Range

    Dim strErrorMessage As String

        Set CellContainingStringInRange = rngSearch.Find(strSearch, LookIn:=xlValues)

        If CellContainingStringInRange Is Nothing _
            Then
                strErrorMessage = "Couldn't find cell """ & strSearch & """ in " & rngSearch.Worksheet.Name
                ErrorMessage (strErrorMessage)
        End If

End Function

5) Purpose: Unhide all data on a worksheet, then [later] return it to its original state.

Public Sub RecordHiddenRowsAndUnhide(ByRef arrHiddenRows As Variant, ByVal LB1 As Long, ByVal UB1 As Long)

    Dim i As Long

    Dim lngCounter As Long

        For i = LB1 To UB1
            If Rows(i).EntireRow.Hidden _
                Then
                    lngCounter = lngCounter + 1
                    ReDim Preserve arrHiddenRows(1 To lngCounter)
                    arrHiddenRows(lngCounter) = i
                    Rows(i).Hidden = False
            End If
        Next i

End Sub

Public Sub RecordHiddenColumnsAndUnhide(ByRef arrHiddenColumns As Variant, ByVal LB2 As Long, ByVal UB2 As Long)

    Dim i As Long

    Dim lngCounter As Long

        For i = LB2 To UB2
            If Columns(i).EntireRow.Hidden _
                Then
                    lngCounter = lngCounter + 1
                    ReDim Preserve arrHiddenColumns(1 To lngCounter)
                    arrHiddenColumns(lngCounter) = i
                    Columns(i).Hidden = False
            End If
        Next i

End Sub

Public Sub HideRows(ByRef arrHiddenRows As Variant)
    Dim i As Long

        For i = LBound(arrHiddenRows) To UBound(arrHiddenRows)
            Rows(i).EntireRow.Hidden = True
        Next i

End Sub

Public Sub HideColumns(ByRef arrHiddenColumns As Variant)
    Dim i As Long

        For i = LBound(arrHiddenColumns) To UBound(arrHiddenColumns)
            Columns(i).EntireRow.Hidden = True
        Next i

End Sub

6) Purpose Given a range (usually a cell), determine the First/Last Row/Column for the area of data it is in.

Public Sub AssignRangeBoundsOfData(ByRef rngCell As Range, Optional ByRef LB1 As Variant, Optional ByRef UB1 As Variant, Optional ByRef LB2 As Variant, Optional ByRef UB2 As Variant)

    Dim wbCurrent As Workbook
    Dim wsCurrent As Worksheet

        AssignCurrentBookAndSheet wbCurrent, wsCurrent

    Dim wsRngCell As Worksheet
    Dim wbRngCell As Workbook

        AssignRangeBookAndSheet rngCell, wbRngCell, wsRngCell

        wbRngCell.Activate
        wsRngCell.Activate

    Dim rngCurrentRegion As Range
    Set rngCurrentRegion = rngCell.CurrentRegion

        If Not IsMissing(LB1) Then LB1 = rngCurrentRegion.Row
        If Not IsMissing(LB2) Then LB2 = rngCurrentRegion.Column

        If Not IsMissing(UB1) Then UB1 = rngCurrentRegion.Row + rngCurrentRegion.Rows.Count - 1
        If Not IsMissing(UB2) Then UB2 = rngCurrentRegion.Column + rngCurrentRegion.Columns.Count - 1

        wbCurrent.Activate
        wsCurrent.Activate

End Sub

7) Purpose: Iteratively copy the contents of one array to another. (I have since learnt about arr1 = arr2 but I figure it may come in useful someday). Identical methods for 4d, 3d etc.

Public Sub CopyArrayContents5d(ByRef arrSource As Variant, ByRef arrDestination As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long
    Dim LB3 As Long, UB3 As Long
    Dim LB4 As Long, UB4 As Long
    Dim LB5 As Long, UB5 As Long

    Dim i As Long, j As Long, k As Long
    Dim l As Long, m As Long

        AssignArrayBounds arrSource, LB1, UB1, LB2, UB2, LB3, UB3, LB4, UB4, LB5, UB5

        Erase arrDestination
        ReDim arrDestination(LB1 To UB1, LB2 To UB2, LB3 To UB3, LB4 To UB4, LB5 To UB5)

        For i = LB1 To UB1
        For j = LB2 To UB2
        For k = LB3 To UB3
        For l = LB4 To UB4
        For m = LB5 To UB5
            arrDestination(i, j, k, l, m) = arrSource(i, j, k, l, m)
        Next m
        Next l
        Next k
        Next j
        Next i

End Sub

8) Purpose: Return the L/U bounds for specified dimensions (up to 5) of a given array.

Public Sub AssignArrayBounds(ByRef arrCurrentArray As Variant, _
                                Optional ByRef LB1 As Variant, Optional ByRef UB1 As Variant, _
                                Optional ByRef LB2 As Variant, Optional ByRef UB2 As Variant, _
                                Optional ByRef LB3 As Variant, Optional ByRef UB3 As Variant, _
                                Optional ByRef LB4 As Variant, Optional ByRef UB4 As Variant, _
                                Optional ByRef LB5 As Variant, Optional ByRef UB5 As Variant)

    If Not IsMissing(LB1) Then LB1 = LBound(arrCurrentArray, 1)
    If Not IsMissing(UB1) Then UB1 = UBound(arrCurrentArray, 1)
    If Not IsMissing(LB2) Then LB2 = LBound(arrCurrentArray, 2)
    If Not IsMissing(UB2) Then UB2 = UBound(arrCurrentArray, 2)
    If Not IsMissing(LB3) Then LB3 = LBound(arrCurrentArray, 3)
    If Not IsMissing(UB3) Then UB3 = UBound(arrCurrentArray, 3)
    If Not IsMissing(LB4) Then LB4 = LBound(arrCurrentArray, 4)
    If Not IsMissing(UB4) Then UB4 = UBound(arrCurrentArray, 4)
    If Not IsMissing(LB5) Then LB5 = LBound(arrCurrentArray, 5)
    If Not IsMissing(UB5) Then UB5 = UBound(arrCurrentArray, 5)

End Sub

9) Purpose: Transpose a 2D array. I've had bad experiences with Excel's Transpose function so I wrote my own.

Public Sub Transpose2dArray(ByRef arrCurrentArray As Variant)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long

    Dim i As Long, j As Long

        AssignArrayBounds arrCurrentArray, LB1, UB1, LB2, UB2

    Dim arrTransposedArray() As Variant
    ReDim arrTransposedArray(LB2 To UB2, LB1 To UB1)

        For i = LB1 To UB1
        For j = LB2 To UB2
            arrTransposedArray(j, i) = arrCurrentArray(i, j)
        Next j
        Next i

    Erase arrCurrentArray
    ReDim arrCurrentArray(LB2 To UB2, LB1 To UB1)

        arrCurrentArray = arrTransposedArray

End Sub

10) Purpose: Print the contents of a 2D Array to a Worksheet

Public Sub Print2dArrayToSheet(ByRef wbTarget As Workbook, ByRef wsTarget As Worksheet, ByRef arrData As Variant, ByRef rngStartCell As Range)

    Dim LB1 As Long, UB1 As Long
    Dim LB2 As Long, UB2 As Long

    Dim rngTableRange As Range

        wbTarget.Activate
        wsTarget.Activate

        AssignArrayBounds arrData, LB1, UB1, LB2, UB2
    Set rngTableRange = Range(rngStartCell, Cells(rngStartCell.Row + UB1 - LB1, rngStartCell.Column + UB2 - LB2))
        rngTableRange = arrData

End Sub

11) Purpose: Copy a column of Data from one Array to another.

Public Sub CopyArrayColumn2d(ByRef arrSource As Variant, ByVal lngSourceColumn As Long, ByRef arrTarget As Variant, ByVal lngTargetColumn As Long)

    Dim i As Long, j As Long, k As Long

    Dim LB1 As Long, UB1 As Long

        AssignArrayBounds arrSource, LB1, UB1

        For i = LB1 To UB1
            arrTarget(i, lngTargetColumn) = arrSource(i, lngSourceColumn)
        Next i

End Sub

12) Return Value: A 1D Array containing a specified row from a 2D array. Mainly used for searching for desired columns by their headings.

Public Function RowFrom2dArray(ByRef arrSource As Variant, ByVal lngRow As Long) As Variant

    Dim LB2 As Long, UB2 As Long
    Dim i As Long

        AssignArrayBounds arrSource, LB2:=LB2, UB2:=UB2

        ReDim RowFrom2dArray(LB2 To UB2)

        For i = LB2 To UB2
            RowFrom2dArray(i) = arrSource(lngRow, i)
        Next i

End Function

13) Return Value: The index of a value in a 1D Array. I could use application.match() but I have also had bad experiences with that one

Public Function IndexInArray1d(ByRef arrSource As Variant, ByVal varSearch As Variant) As Variant

    Dim LB1 As Long, UB1 As Long

    Dim bMatchFound As Boolean

    Dim i As Long

        AssignArrayBounds arrSource, LB1, UB1
        bMatchFound = False

        i = LB1
        Do While i <= UB1 And bMatchFound = False
            If arrSource(i) = varSearch _
                Then
                    bMatchFound = True
                    IndexInArray1d = i
            End If
            i = i + 1
        Loop

        If Not bMatchFound Then IndexInArray1d = CVErr(xlErrValue)

End Function

14) Purpose: Assign either the Current Book/Sheet or the Book/Sheet of a range object to variables.

Public Sub AssignCurrentBookAndSheet(ByRef wbCurrent As Workbook, ByRef wsCurrent As Worksheet)

    Set wbCurrent = ThisWorkbook
    Set wsCurrent = ActiveSheet

End Sub

Public Sub AssignRangeBookAndSheet(ByRef rngTarget As Range, ByRef wbTarget As Workbook, ByRef wsTarget As Worksheet)

    Set wbTarget = rngTarget.Worksheet.Parent
    Set wsTarget = rngTarget.Worksheet

End Sub

15) Purpose: Iteratively write the contents of a range to an Array. Mainly so I can add the worksheet name into array(0,0). Also for situations where I don't want to/can't use arrFoo = rngBar.

Public Sub WriteRangeToArrayIteratively(ByRef wsCurrent As Worksheet, arrCurrentArray As Variant, ByVal LB1 As Long, ByVal UB1 As Long, ByVal LB2 As Long, ByVal UB2 As Long)
    Dim i As Long, j As Long

    wsCurrent.Activate

    ReDim arrCurrentArray(0 To UB1 - LB1 + 1, 0 To UB2 - LB2 + 1)
        arrCurrentArray(0, 0) = wsCurrent.Name

        For i = LB1 To UB1
            For j = LB2 To UB2
                arrCurrentArray(i - LB1 + 1, j - LB2 + 1) = wsCurrent.Cells(i, j)
            Next j
        Next i

End Sub

16) Purpose: Store, Disable and Retrieve Application Settings

Public Sub StoreApplicationSettings()

    varScreenUpdating = Application.ScreenUpdating
    varEnableEvents = Application.EnableEvents
    varCalculation = Application.Calculation

End Sub

Public Sub DisableApplicationSettings()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

End Sub

Public Sub RestoreApplicationSettings()

    Application.ScreenUpdating = varScreenUpdating
    Application.EnableEvents = varEnableEvents
    Application.Calculation = varCalculation

End Sub

17) Purpose: General MsgBox Debug.Print Stop Error Handler

Public Sub ErrorMessage(ByVal strErrorMessage As String)

    MsgBox strErrorMessage
    Debug.Print strErrorMessage
    RestoreApplicationSettings
    Stop

End Sub

18) Purpose: Convert elements of a 1D Array to strings

Public Function ElementsToStrings1dArray(ByRef arrSource As Variant) As Variant

    Dim i As Long

        For i = LBound(arrSource) To UBound(arrSource)
            arrSource(i) = CStr(arrSource(i))
        Next i

End Function

19) Purpose: Close a workbook with warnings disabled

Public Sub CloseWorkbook(ByRef wbTarget As Workbook)

    Application.DisplayAlerts = False
        wbTarget.Close
    Application.DisplayAlerts = True

End Sub
\$\endgroup\$

closed as too broad by Barry, Simon Forsberg Dec 7 '15 at 17:56

Please edit the question to limit it to a specific problem with enough detail to identify an adequate answer. Avoid asking multiple distinct questions at once. See the How to Ask page for help clarifying this question. If this question can be reworded to fit the rules in the help center, please edit the question.

  • 1
    \$\begingroup\$ Right now, it looks like you're asking us to review almost 20 separate bits of code. If they're all part of the same thing, please put them together. You can add the purpose of each block of code in comments. \$\endgroup\$ – Nic Hartley Dec 7 '15 at 21:27
  • \$\begingroup\$ Your routine WriteRangeToArrayIteratively will be much too slow, especially for larger ranges. You can set an array's values to the values in a range by declaring the array variable as a variant and setting it equal to the range's values; the result is an array of values: vArray = myRange.Value \$\endgroup\$ – Jon Peltier Oct 23 '17 at 14:36
7
\$\begingroup\$

I'm feeling lazy, so I'll just pick the low hanging fruit.

Public Sub GetWorkbook(ByVal strFilename As String, ByVal strFilePath As String)

    Dim bWbIsOpen As Boolean

    bWbIsOpen = WorkbookIsOpen(strFilename)
    If Not bWbIsOpen Then Workbooks.Open strFilePath & strFilename

End Sub

This could potentially fail if the workbook doesn't exist at the specified path. I would use the Scripting runtime to check if the path even exists prior to checking to see if the workbook is open. As it is, your IsWorkbookOpen will return false if it doesn't exist(which is good and correct), but then you'll get an unhandled runtime error when you try to open the nonexistent file. Personally, I would make the Open routine a function that returns a Boolean success value, but that depends on your overall error handling strategy. Either you need to wrap every OpenWorkbook call with an error handler, or wrap it with a check on its success status. I find the success status to be more convenient in VBA, but my method of doing it is reminiscent of how things were done in C.

Okay, so I'm rambling, but the TL;DR version is your approach here depends on if you're using VBA as a procedural language or an object oriented one. (It's very capable of both.) If you're using a procedural style, go with the return value.

\$\endgroup\$
  • 2
    \$\begingroup\$ I would make the Open routine a function that returns a Boolean success value - using the return value of Workbooks.Open (a Workbook object reference) and returning that Workbook reference on success, and Nothing in case of error, would be another good way to do this. \$\endgroup\$ – Mathieu Guindon Aug 30 '15 at 23:55
  • \$\begingroup\$ Indeed @Mat'sMug. That would be a very nice way to go about it. \$\endgroup\$ – RubberDuck Aug 31 '15 at 0:07
  • \$\begingroup\$ Actually, I would return a workbook, either the one that was already open, or the newly opened one, or Nothing. The calling code would check for Nothing, then proceed as appropriate. \$\endgroup\$ – Jon Peltier May 8 '16 at 15:21
  • 1
    \$\begingroup\$ Something to also note about GetWorkbook is that if the workbook is corrupt this will still fail. Use workbooks.Open(filename:=path, CorruptLoad:=Excel.XlCorruptLoad.xlRepairFile) instead. Really there should just be proper error checking in the function... Might also want to set Application.DisplayAlerts and Application.AskToUpdateLinks to false \$\endgroup\$ – Sancarn Jan 25 at 16:59

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