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
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
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
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
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
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
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
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
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.
This will create a folder using the base name of your Excel file, which is the filename without its extension, along with a
vba subfolder. Your VBA modules will be placed there.
Set Reference to Microsoft Visual Basic for Applications Extensibility
Sub ExportModules( _ Optional PathToVBAModules As String = "" _ ) Dim objMyProj As VBProject Dim objVBComp As VBComponent Dim strExt As String Set objMyProj = Application.VBE.ActiveVBProject If PathToVBAModules = "" Then MakeFolder _ ThisWorkbook.Path & _ "\" & _ GetBaseName( _ ThisWorkbook.Name _ ) & _ "\" MakeFolder _ ThisWorkbook.Path & _ "\" & _ GetBaseName( _ ThisWorkbook.Name _ ) & _ "\vba" PathToVBAModules = _ ThisWorkbook.Path & _ "\" & _ GetBaseName( _ ThisWorkbook.Name _ ) & _ "\vba\" Else ' Leave provided path End If For Each objVBComp In objMyProj.VBComponents Select Case objVBComp.Type Case vbext_ct_StdModule strExt = ".bas" Case vbext_ct_ClassModule strExt = ".cls" Case vbext_ct_MSForm strExt = ".frm" Case vbext_ct_Document strExt = ".txt" End Select objVBComp.Export PathToVBAModules & objVBComp.Name & strExt Next End Sub