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
WriteRangeToArrayIterativelywill 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\$