-
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
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
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
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
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
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
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
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
-
Export Modules to Folder
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 ExtensibilitySub 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