Option Explicit

Category: VBA

  • SlicerCount

    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

    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
  • Ellipsize

    Ellipsize

    Public Function Ellipsize( _
    strInput As String, _
    Optional MaxLength As Integer = 16 _
) As String
    If Len(strInput) > MaxLength Then
        Ellipsize = Left(strInput, MaxLength) & Chr(133)
    Else
        Ellipsize = strInput
    End If
End Function
  • TransferRangeDataAsArray

    TransferRangeDataAsArray

    Public Function TransferRangeDataAsArray( _
    rngSource As Range, _
    rngTarget As Range, _
    Optional xlrvd As XlRangeValueDataType = xlRangeValueDefault _
) As Range
    Set TransferRangeDataAsArray = _
        rngTarget.Resize( _
            rngSource.Rows.Count, _
            rngSource.Columns.Count _
        )
    TransferRangeDataAsArray.Value( _
        xlrvd _
    ) = _
        rngSource.Value( _
            xlrvd _
        )
    End Function
  • HasKey

    HasKey

    Function HasKey( _
    coll As Collection, _
    index As Variant _
) As Boolean
On Error GoTo ErrorHandler
    Dim elTest As Variant
    HasKey = False
    elTest = coll(index)
    HasKey = True
    Exit Function
ErrorHandler:
End Function
  • ElapsedTime

    ElapsedTime

    Function ElapsedTime( _
    endTime As Date, _
    startTime As Date _
) As String
    Dim Interval As Date
    ' Calculate the time interval.
    Interval = endTime - startTime
    ' Format and print the time interval in 
    ' days, hours, minutes and seconds.
    ElapsedTime = _
        Int( _
            CSng( _
                Interval _
            ) _
        ) & _
        " days " & _
        Format( _
            Interval, _
            "hh" _
        ) & _
        " Hours " & _
        Format( _
            Interval, _
            "nn" _
        ) & _
        " Minutes " & _
        Format( _
            Interval, _
            "ss" _
        ) & _
        " Seconds"
End Function

    This has been adapted from https://docs.microsoft.com/en-us/office/vba/access/concepts/date-time/calculate-elapsed-time

  • RenderListControlHeadings

    RenderListControlHeadings

    Public Sub RenderListControlHeadings( _
    ListControl As Control, _
    ColumnHeadingString As String, _
    Optional FontWeight As Long = 400, _
    Optional OffsetLeft As Long = 8 _
)
    Dim ctls As Controls
    Dim iCtl As Control
    Dim strControlNameStub As String
    Dim strLabelNameStub As String
    Set ctls = ListControl.Parent.Controls
    strLabelNameStub = "lbheading_"
    strControlNameStub = _
        strLabelNameStub & _
        ListControl.Name
    Set ctls = ListControl.Parent.Controls
    For Each iCtl In ctls
        If Left( _
            iCtl.Name, _
            Len( _
                strControlNameStub _
            ) _
        ) = strControlNameStub Then
            ctls.Remove iCtl.Name
        End If
    Next iCtl
    If ColumnHeadingString = "" Then Exit Sub
    Dim arrWidths As Variant
    Dim arrHeadings As Variant
    arrWidths = Split( _
        ListControl.ColumnWidths, _
        ";" _
    )
    arrHeadings = Split( _
        ColumnHeadingString, _
        ";" _
    )
    Dim i As Integer
    Dim accLeftPosition As Long
    accLeftPosition = ListControl.Left + OffsetLeft
    For i = 0 To UBound(arrHeadings)
        With ctls.Add( _
            "Forms.Label.1", _
            strControlNameStub & i _
        )
            .Caption = arrHeadings(i)
            .Left = accLeftPosition
            .Top = ListControl.Top - 12
            .Font.Size = 7
            .Font.Weight = FontWeight
            .BackStyle = fmBackStyleTransparent
        End With
        accLeftPosition = _
            accLeftPosition + _
            CLng( _
                Trim( _
                    Replace( _
                        arrWidths(i), _
                        " pt", "" _
                    ) _
                ) _
            )
    Next i
End Sub
  • DeleteAllFilesInFolder

    DeleteAllFilesInFolder

    Public Sub DeleteAllFilesInFolder( _
    strPathToFolder As String _
)
    Dim _
        fs As Object, _
        fldr As Object, _
        f As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fldr = fs.GetFolder(strPathToFolder)
    For Each f In fldr.Files
        Application.StatusBar = _
            "Deleting file " & _
            f.Name & _
            " from folder " & _
            strPathToFolder
        DoEvents
        f.Delete True
    Next
    Set f = Nothing
    Set fldr = Nothing
    Set fs = Nothing
    Application.StatusBar = False
End Sub
  • HasHiddenColumns

    HasHiddenColumns

    Public Function HasHiddenColumns( _
  rng As Range _
) As Boolean
  Dim _
    rngColumn As Range
  HasHiddenColumns = False
  For Each rngColumn In rng.Columns
    If rngColumn.Hidden Then
      HasHiddenColumns = True
    End If
  Next rngColumn
End Function

    Usage:

    Dim _
  wsSource As Worksheet, _
  rngSource as Range
Set wsSource = ThisWorkbook.Sheets("Sheet1")
Set rngSource = wsSource.Range("A1", "K32")
If HasHiddenColumns( _
  rngSource _
) Then
  ' Handle it
End If
  • Notes on VBA Coding Style: Maximizing Scalability and Readability

    Notes on VBA Coding Style: Maximizing Scalability and Readability

    Establishing and adhering to a VBA coding style guide enables increased project reusability and scalability. It makes code more readable and, by extension, the coding experience far more enjoyable.

    Notes on VBA Coding Style

    Minimize Horizontal Scrolling

    Split lines (use the underscore!) and indent. My rationale is that horizontal scrolling takes too long. You want to be able to scan through your code quickly. You also want to be able to view code modules side-by-side, which ties into another upcoming post (TODO…) regarding code modularity – specifically, if your procedure is going to be lengthy, consider placing it in its own module, and ALWAYS use a naming convention. This applies to variables and modules. Pick a convention and stick to it. The VBE (Visual Basic Editor) has split screen, but that only works with a horizontal separator. It is helpful to be able to view code side-by-side, particularly if you’re writing class definitions that may have similar implementations. If your lines are short, you can view more modules side-by-side.

    The screenshot illustrates the following conventions that I like to use:

    Split line after open parentheses and each parameter

    This includes the first line of any procedure definition (Sub, Property, Function).
    Each parameter should be on its own line. Be mindful of proper syntax with regards to commas. This will drive you crazy if you’re not careful. The debugger is your friend. So, for instance:

    Function MyFunction( _
  strParamOne as String, _
  strParamTwo as String, _
  intParamCounter as Integer, _
  strLastParam as String _
)

    Note the comma-space-underscore syntax for all parameters except the last one. The debugger will yell at you about this, but do yourself a favor and form the habit.

    Split line after Dim statement when declaring multiple variables

    This ties into my convention for splitting lines after multiple parameters. It may not be necessary for single parameters, but consider that VBA permits you to use up to 1,203 characters to name your variables. That enables you to be descriptive with your variable names, which you should be, because someone will probably have to decipher that code of yours eventually – and it might just be you. NEVER use non-descriptive variable names such as a, b, c or x, y, z. Just don’t do it. So, conserve your horizontal space on each line.  For instance:

    Dim strMyVariable as String

    Keeping a single variable declaration on one line may be acceptable. It’s up to you. Just make a decision and stick to it. If you have a long variable name, you might want to conserve some space like this:

    Dim _
  strWorksheetNameConcatenatedFromSourceWorkbook as String

    When declaring multiple variables, I like to give them each their own indented line:

    Dim _
  strMyFirstVariable as String, _
  strMySecondVariable as String, _
  intMyThirdVariable as Integer, _
  strMyLastVariable as String

    Split lengthy strings into separate lines

    Your mileage may vary on this, but I think 80 characters is a good limit to set. Split your strings and concatenate them with an ampersand, then use ampersand-space-underscore to split your lines:

    strMyLongString = _
  "This will be a " & _
  "run-on sentence with " & _
  "a few variables thrown in " & _
  "here: " & _
  strMyFirstConcatenatedStringElement & _
  " and here: " & _
  strMySecondConcatenatedStringElement & _
  " to properly illustrate my " & _
  "point."

    Note that there is a limit on VBA line continuations (see Microsoft Office Dev Center Article). Per the specs: Your code should have no more than 25 physical lines joined with line-continuation characters or more than 24 consecutive line-continuation characters in a single line. Make some of the constituent lines physically longer to reduce the number of line-continuation characters needed, or break the construct into more than one statement.

    Be Verbose

    Function and Object names get compiled down so their length does not affect performance. VBA is meant to enable verbosity. Use camel case and name your functions and objects explicitly. Establish a naming convention early on if possible. For example, the following variable has a three letter prefix indicating its data type (string, in this case), then a concise camel case description of the variable’s purpose. 

    strWorksheetName

    Whether you use this VBA coding style guide or build your own, the important thing is to adhere to it throughout your project, especially if you are working with a team. It helps to speak the same language, both programmatically and stylistically. The less guesswork is involved, the more efficiently you can get things done.