Option Explicit

Code

  • DeleteVBACodeFromWorkbook

    Sub DeleteVBACodeFromWorkbook( _
    wb As Workbook _
)
    Dim _
        vbc As VBComponent
    For Each vbc In wb.VBProject.VBComponents
        If vbc.Type <> vbext_ct_Document Then
            wb.VBProject.VBComponents.Remove vbc
        End If
    Next vbc
End Sub

  • GetFilePath

    Public Function GetFilePath( _
    sFullFileNameWithPath As String _
) As String
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    GetFilePath = _
        fs.GetAbsolutePathName( _
            sFullFileNameWithPath _
        )
End Function

  • GetFileNameFromFullPath

    Public Function GetFileNameFromFullPath( _
    sFullFileNameWithPath As String _
) as String
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    GetFileNameFromFullPath = _
        fs.GetFilename( _
            sFullFileNameWithPath _
        )
    Set fs = Nothing
End Function

  • GetBaseName

    Public Function GetBaseName( _
    sFullFileNameWithExtension As String _
)
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    GetBaseName = _
        fs.GetBaseName( _
            sFullFileNameWithExtension _
        )
    Set fs = Nothing
End Function

  • TransferFontProperties

    Public Sub TransferFontProperties( _
    rngSource As Range, _
    rngTarget As Range _
)
    Dim sf As Font
    Set sf = rngSource.Font
    With rngTarget.Font
        .Name = sf.Name
        .Size = sf.Size
        .Strikethrough = sf.Strikethrough
        .Superscript = sf.Superscript
        .Underline = sf.Underline
        .Color = sf.Color
        .Italic = sf.Italic
        .TintAndShade = sf.TintAndShade
        .Subscript = sf.Subscript
        .Bold = sf.Bold
    End With
End Sub

  • TrimRange

    Public Function TrimRange( _
    rngSource As Range, _
    Optional TrimTop As Integer = 0, _
    Optional TrimBottom As Integer = 0, _
    Optional TrimLeft As Integer = 0, _
    Optional TrimRight As Integer = 0 _
) As Range
    Set TrimRange = _
        rngSource.Offset( _
            rowoffset:=TrimTop, _
            columnoffset:=TrimLeft _
        ).Resize( _
            rngSource.Rows.Count - TrimTop - TrimBottom, _
            rngSource.Columns.Count - TrimLeft - TrimRight _
        )
End Function

  • VBComponentNameIsUnique

    Public Function VBComponentNameIsUnique( _
    wb As Workbook, _
    strInputName As String _
) As Boolean
    Dim vbc As VBComponent
    VBComponentNameIsUnique = True
    For Each vbc In wb.VBProject.VBComponents
        If vbc.Name = strInputName Then
            VBComponentNameIsUnique = False
        End If
    Next vbc
End Function

  • MatchesPattern

    Public Function MatchesPattern( _
    strInputTest As String, _
    strInputPattern As String, _
    Optional IgnoreCase As Boolean = True, _
    Optional IsGlobal As Boolean = True _
) As Boolean
    On Error GoTo Catch
    Dim objRegExp As New RegExp
    Set objRegExp = Nothing
    objRegExp.IgnoreCase = IgnoreCase
    objRegExp.Global = IsGlobal
    objRegExp.Pattern = strInputPattern
    MatchesPattern = objRegExp.Test( _
        strInputTest _
    )
    Set objRegExp = Nothing
    Exit Function
Catch:
    Set objRegExp = Nothing
End Function

  • SlicerCount

    Public Function SlicerCount( _
    scl As SlicerCacheLevel, _
    Optional NonBlankOnly As Boolean = True, _
    Optional Verbose As Boolean = True _
)
    Dim si As SlicerItem
    Dim iCount As Integer
    Dim iVerboseCount As Integer
    Dim iTotal As Integer
    iCount = 0
    If Verbose Then
        iVerboseCount = 0
        iTotal = scl.SlicerItems.Count
    End If
    For Each si In scl.SlicerItems
        If NonBlankOnly Then
            If SlicerItemIsPopulated(si) Then
                iCount = iCount + 1
            End If
        Else
            iCount = iCount + 1
        End If
        If Verbose Then
            iVerboseCount = iVerboseCount + 1
            Application.StatusBar = _
                "Counting Slicer Items (" & _
                Pct( _
                    iVerboseCount, _
                    iTotal _
                ) & _
                " complete)..."
        End If
    Next si
    SlicerCount = iCount
    If Verbose Then
        Application.StatusBar = False
    End If
End Function

  • DeleteHiddenSourceColumnsFromTarget

    Public Sub DeleteHiddenSourceColumnsFromTarget( _
    rngSource As Range, _
    rngTarget As Range _
)
    Dim _
        rngColumn As Range, _
        intSourceColumnInitialOffset As Integer, _
        intSourceRowInitialOffset As Integer, _
        iColumn As Integer
    With rngSource.Cells(1, 1)
        intSourceColumnInitialOffset = .Column
        intSourceRowInitialOffset = .Row
    End With
    For iColumn = rngSource.Columns.Count To 1 Step -1
        If rngSource.Columns(iColumn).Hidden Then
            rngTarget.Columns(iColumn).Delete
        End If
    Next iColumn
End Sub