Standard Methods in VBA [closed]

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