Useful VBA Functions

UBound function for dynamic arrays

'The UBound function made 'safe' for use with dynamic arrays.
'Returns -1 if the array is not initialised rather than error 9:
'subscript out of range.
Function UBoundSafe(Arr As Variant, Optional Dimension As Long = 1)
    On Error GoTo ErrHandler
    UBoundSafe = UBound(Arr, Dimension)
    Exit Function
ErrHandler:
    If Err.Number = 9 Then
        UBoundSafe = -1
    Else
        On Error GoTo 0
        Resume
    End If
End Function

Last cell containing data in a column

'Returns the last cell containing data in Column
' If the range Column:
'  * contains more than one column then the first will be used.
'  * is not an entire column then the last cell returned will
'    never be before the first cell in the range.
'Examples:
'  * Last cell in col A:
'       LastCellInColumn(Columns("A"))
'  * Last cell in col B, starting from row 2:
'       LastCellInColumn(Range("B2"))
Public Function LastCellInColumn(Column As range) As range
    With Column.EntireColumn
        Set LastCellInColumn = .Rows(.Rows.Count).End(xlUp)
    End With
    If LastCellInColumn.Row < Column.Row Then
        Set LastCellInColumn = Column.Cells(1)
    End If
End Function

Efficiently copy cell values

'Efficiently copy values (only) between ranges.
'If Source contains non-contiguous areas only the first will be copied.
Public Sub ArrayCopy(Source As range, Destination As range)
    Dim Values As Variant
    Values = Source.Value2
    Destination.Resize(Source.Rows.Count, _
                       Source.Columns.Count) = Values
End Sub

Extension from a filename

'Get the extension from a filename
Function FileExtension(Filename As String) As String
    Dim Length As Long
    Dim Pos As Long
    Length = Len(Filename)
    For Pos = Length To 1 Step -1
        Select Case Mid(Filename, Pos, 1)
        Case "."
            If Pos < Length Then _
                FileExtension = LCase(Right(Filename, Length - Pos))
            Exit For
        Case "\", "/"
            Exit For
        End Select
    Next Pos
End Function

Does a sheet exist in the workbook

'Does a sheet with this name exist in the parent workbook.
Function SheetExists(Parent As Workbook, Name As String) As Boolean
    On Error GoTo errHandler
    If Not Parent.Sheets(Name) Is Nothing Then SheetExists = True
    Exit Function
    'Error 9 "Subscript out of range" means the sheet does not exist in
    'the workbook. For any other error, cancel error handling and raise
    'the error again (resume).
errHandler:
    If Err.Number <> 9 Then On Error GoTo 0: Resume
End Function