Blogs

Nick's picture

XLA routines: EE_PrevBusinessDay

EE_PrevBusinessDay takes a date, and a holiday calendar and returns the previous business day.
Function EE_PrevBusinessDay(rngHolidays As range, dt As Date) As Date
'Takes a date, a range of holidays, and returns the previous business day
    Dim intPvs     As Integer
    Dim dtPvs      As Date
 
'http://excelexperts.com/xla-routines-eePrevBusinessDay    for updates on this function

    intPvs = 1
    Do While True
        dtPvs = DateAdd("d", 0 - intPvs, dt)
        If EE_IsBusinessDay(rngHolidays, dtPvs) Then
            EE_PrevBusinessDay = dtPvs
            Exit Func
Nick's picture

XLA routines: EE_NextBusinessDay

EE_NextBusinessDay takes a date, and a holiday calendar and returns the next business day.
Function EE_NextBusinessDay(rngHolidays As range, dt As Date) As Date
'Takes a date, a range of holidays, and returns the next business day
    Dim intNext     As Integer
    Dim dtNext      As Date
 
'http://excelexperts.com/xla-routines-eeNextBusinessDay    for updates on this function

    intNext = 1
    Do While True
        dtNext = DateAdd("d", intNext, dt)
        If EE_IsBusinessDay(rngHolidays, dtNext) Then
            EE_NextBusinessDay = dtNext
            Exit Function
 
Nick's picture

XLA routines: EE_IsBusinessDay

EE_IsBusinessDay is a very useful financial function that returns whether a date is a business day.
Nick's picture

XLA Routines: EE_IsWeekend

EE_IsWeekend is a function that takes a date, and returns whether it is a weekend.
Function EE_IsWeekend(dt As Date) As Boolean
'Takes a date, returns if it's a weekend
'http://excelexperts.com/xla-routines-eeIsWeekend    for updates on this function

    Select Case Format(dt, "w")
        Case vbSaturday, vbSunday
            EE_IsWeekend = True
        Case Else
            EE_IsWeekend = False
    End Select
End Function
Nick's picture

XLA routines: EE_IsWeekday

EE_IsWeekday is a function that takes a date, and returns whether it is a weekday.
Function EE_IsWeekday(dt As Date) As Boolean
'Takes a date, returns if it's a weekday
'http://excelexperts.com/xla-routines-eeIsWeekday    for updates on this function

    Select Case Format(dt, "w")
        Case vbSaturday, vbSunday
            EE_IsWeekday = False
        Case Else
            EE_IsWeekday = True
    End Select
End Function
Nick's picture

XLA routines: EE_SendReport

EE_SendReport is a hugely useful routine that sends a range as an email - can also add attachments like zipped up files - requires ms outlook
Sub EE_SendReport(rptRange As range, recipients As range, Files As range, Optional SendOrDisplay As Boolean, Optional ZipFileName As String)
'RptRange is a range containing text we want to be contained in the body
'Recipients is range containing email addresses Files is range containing
'list of files that we will zip up and add to mail SendOrDisplay - If= Send, mail is sent..
Nick's picture

XLA routines: EE_ZipFile

EE_ZipFile is a routine that zips a file.
Nick's picture

XLA routines: EE_SheetExists

EE_SheetExists is a simple function that returns whether a sheet exists
Function EE_SheetExists(strSheetName As String, Optional wb As Workbook) As Boolean
    Dim wbk             As Workbook
 
'http://excelexperts.com/xla-routines-eeSheetExists    for updates on this function

    If IsMissing(wb) Or wb Is Nothing Then
        Set wbk = ActiveWorkbook
    Else
        Set wbk = wb
    End If
 
    On Error Resume Next
        EE_SheetExists = Not (wbk.Worksheets(strSheetName) Is Nothing)
    Err.Clear: On Error GoTo 0: On Error GoTo -1
End Function
Nick's picture

XLA routines: EE_GetTempPath

EE_GetTempPath is a utility function that returns the temp path.
Function EE_GetTempPath() As String
'http://excelexperts.com/xla-routines-eeGetTempPath    for updates on this function
    EE_GetTempPath = Environ("Temp")
End Function
Nick's picture

XLA routines: EE_OpenFileFromCell

EE_OpenFileFromCell is a routine that one would use to add to a button - select a cell containing a file name, and press the button to open the file in the Excel session - useful for debugging input files - works with a file name or full path
Sub EE_OpenFileFromCell(rngFileCell As range)
    Dim rngCell As range
 
'http://excelexperts.com/xla-routines-eeOpenFileFromCell    for updates on this sub routine

    For Each rngCell In rngFileCell
        On Error Resume Next
        If InStr(rngCell.value, Application.PathSeparator) > 0 Then
            Application.Workbooks.
Nick's picture

XLA routines: EE_CombineSheets

EE_CombineSheets is a routine that combines the sheets on a workbook - works if the headers are the same
Sub EE_CombineSheets(wbkFrom As Workbook, rngTarget As range, Optional arrSheetNames As Variant)
    Dim intSheets       As Integer
    Dim rngCopy         As range
    Dim rngPaste        As range
    Dim wks             As Worksheet
    Dim wksNew          As Worksheet
    Dim x               As Integer
 
'http://excelexperts.com/xla-routines-eeCombineSheets    for updates on this sub routine
    If IsArray(arrSheetNames) = False Then
        ReDim arrSheetNames(1 
Nick's picture

XLA Routines: EE_ImportFromFile

EE_ImportFromFile is a routine that imports a sheet on a file and puts the results on the target range (the top left cell)
Sub EE_ImportFromFile(wbkFullPath As String, strSheet As String, rngTarget As range)
    Dim wbkSrc      As Workbook
    Dim wksSrc      As Worksheet
 
'http://excelexperts.com/xla-routines-eeImportFromFile    for updates on this function
    If EE_FileExists(wbkFullPath) = False Then Exit Sub
 
    Set wbkSrc = Workbooks.Open(wbkFullPath)
    Set wksSrc = wbkSrc.Worksheets(strSheet)
 
    wksSrc.UsedRange.Copy
    rngTarget.PasteSpecial xlPast
Nick's picture

XLA routines: EE_FileFolderExists

Function to return whether a folder exists
Public Function EE_FileFolderExists(strFullPath As String) As Boolean
'http://excelexperts.com/xla-routines-eeFileFolderExists    for updates on this function
    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then EE_FileFolderExists = True
    Err.Clear: On Error GoTo 0: On Error GoTo -1
EarlyExit:
    On Error GoTo 0
End Function
Nick's picture

XLA routines: EE_FileExists

Function to return whether a file exists
Function EE_FileExists(strFile As String) As Boolean
'http://excelexperts.com/xla-routines-eeFileExists    for updates on this function
    EE_FileExists = CreateObject("Scripting.FileSystemObject").FileExists(strFile)
End Function
Nick's picture

XLA routines: EE_CurrentRegionFromCell

EE_CurrentRegionFromCell returns the area contiguous to the input cell.
Function EE_CurrentRegionFromCell(rng As range) As range
'http://excelexperts.com/xla-routines-eeCurrentRegionFromCell    for updates on this function
    Set EE_CurrentRegionFromCell = rng.currentregion
End Function
Nick's picture

XLA routines: EE_RemoveDupes

Removing duplicates from a range is something you frequently want to do.
Nick's picture

XLA routines: EE_SortArray

EE_SortArray does what it says on the tin: Sorts an array
Function EE_SortArray(ArrayToSort, Optional descending As Boolean)
'- takes array
'- sorts it
    Dim value As Variant, temp As Variant
    Dim sp As Integer
    Dim leftStk(32) As Long, rightStk(32) As Long
    Dim leftNdx As Long, rightNdx As Long
    Dim i As Long, j As Long
    Dim numEls
 
'http://excelexperts.com/xla-routines-eeSortArray    for updates on this function

    ' account for optional arguments
    numEls = UBound(ArrayToSort)
    ' init pointers
    leftNdx = LBound(ArrayToSort)
    rightNdx = 
Nick's picture

XLA routines: EE_WriteToTextFile

Similar to logging errors, this simple sub routine writes to a text file
Sub EE_WriteToTextFile(strMsg As String, FilePath As String)
    ' Writing a text file using File System Object in VBA
    ' This code requires a reference (In the VBE Tools > References) to Microsoft Scripting Runtime
    Dim fso         As Object
    Dim FSOFile     As Object
    Dim NoOfLoop    As Integer
 
'http://excelexperts.com/xla-routines-eeWriteToTextFile    for updates on this sub routine

    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(FilePath) = True The
Nick's picture

XLA routines: EE_LogError

EE_LogError - logs to temp file if no file specified... logs information.
Nick's picture

XLA routines: EE_GetComputername

EE_GetComputername is a handy function that returns the Computer name - useful if you only want code to run on specific computers
Function EE_GetComputername()
'http://excelexperts.com/xla-routines-eeGetComputername    for updates on this function
    EE_GetComputername = Environ("computername")
End Function
Nick's picture

XLA routines: EE_GetUsername

EE_GetUsername is a handy function that returns the username
Function EE_GetUsername() As String
'http://excelexperts.com/xla-routines-eeGetUsername    for updates on this function
    EE_GetUsername = Environ("username")
End Function
Nick's picture

XLA routines: EE_PivotRemoveSubtotals

EE_PivotRemoveSubtotals allows you to remove the subtotals from your pivot. - in my view, Subtotals should be off by default, as I almost never use them
Sub EE_PivotRemoveSubtotals(pt As PivotTable)
    Dim ptField     As PivotField
 
'http://excelexperts.com/xla-routines-eePivotRemoveSubtotals    for updates on this sub routine

    On Error Resume Next
        For Each ptField In pt.PivotFields
            'Set index 1 (Automatic) to True first
            'so that all other values are set to False
            ptField.Subtotals(1) = True
            ptField.Subtotals(1
Nick's picture

XLA routines: EE_PivotArrangeDataFields

EE_PivotArrangeDataFields allows you to add data fields to your pivot in the format you want.
Sub EE_PivotArrangeDataFields(pt As PivotTable, strField As String, strDisplayName As String, lngSummariseOperation As PvtDataCalc, strNumberFormat As String)
'- as above
'- takes an array of data fields, a new name for them, the 'sum' 'count' etc..
Nick's picture

XLA routines: EE_PivotRemoveFields

Use EE_PivotRemoveFields to remove fields from a pivot table
Sub EE_PivotRemoveFields(pt As PivotTable, FieldsArrayOrRange)
    Dim intFld      As Integer
    Dim arr
 
'http://excelexperts.com/xla-routines-eePivotRemoveFields    for updates on this sub routine

    Select Case TypeName(FieldsArrayOrRange)
        Case "Variant()", "String"
            arr = FieldsArrayOrRange
        Case "Range"
            If FieldsArrayOrRange.Cells.Count = 1 Then
                ReDim arr(0)
                arr(0) = FieldsArrayOrRange
            Else
                arr = Applic
Nick's picture

XLA routines: EE_PivotArrangeRowFields

Once you have created a pivot table, added the page and col fields, you can now add the row fields with EE_PivotArrangeRowFields
Sub EE_PivotArrangeRowFields(pt As PivotTable, FieldsArrayOrRange)
'- as above but for row fields
    Dim ptRowField  As PivotField
    Dim intFld      As Integer
    Dim arr
 
'http://excelexperts.com/xla-routines-eePivotArrangeRowFields    for updates on this sub routine

    For Each ptRowField In pt.rowfields
        ptRowField.Orientation = xlHidden
    Next ptRowField
 
    Select Case TypeName(FieldsArrayOrRange)
        Case "Variant()
Nick's picture

XLA routines: EE_PivotArrangeColFields

Once you have created a pivot table, added the page fields, you can now add the col fields with EE_PivotArrangeColFields
Sub EE_PivotArrangeColFields(pt As PivotTable, FieldsArrayOrRange)
'- as above but for col fields
    Dim ptColField  As PivotField
    Dim intFld      As Integer
    Dim arr
 
'http://excelexperts.com/xla-routines-eePivotArrangeColFields    for updates on this sub routine

    For Each ptColField In pt.ColumnFields
        ptColField.Orientation = xlHidden
    Next ptColField
 
    Select Case TypeName(FieldsArrayOrRange)
        Case "Variant()"
Nick's picture

XLA routines: EE_PivotArrangePageFields

Once you have created a pivot table, the next thing you want to do is add to the page fields EE_PivotArrangePageFields allows you to do this passing in a range containing the fields you want added
Sub EE_PivotArrangePageFields(pt As PivotTable, FieldsArrayOrRange)
'- takes an array of fields and moves them to the page area
'- takes the pivot to operate on
'- resume next through errors
'- remove page fields that are not on the list
'- ensures the order of the array is reflected in the pivot

'http://excelexperts.com/xla-routines-eePivotArrangePageFields    for updates on this s
Nick's picture

XLA routines: EE_CreatePivotTableFromRange

EE_CreatePivotTableFromRange creates a pivot table from a range
Function EE_CreatePivotTableFromRange(rngPivotSource As range, rngPivotTarget As range) As Boolean
    Dim wbk             As Workbook
    Dim objPivotCache   As PivotCache
    Dim objPivotTable   As PivotTable
 
'http://excelexperts.com/xla-routines-eeCreatePivotTableFromRange    for updates on this function
    On Error Resume Next
        Set wbk = rngPivotSource.Parent.Parent
 
        Set objPivotCache = wbk.PivotCaches.Create(xlDatabase, rngPivotSource.Address(1, 1, xlA1, True))
        Set objPi
Nick's picture

XLA routines: EE_CreatePivotFromCSV

EE_CreatePivotFromCSV creates a pivot without opening the csv - used for massive files that don't open in Excel
Function EE_CreatePivotFromCSV(ByVal strFullCSVFilePath As String, wksPivotSheet As Worksheet) As Boolean
'- takes a CSV file path
'- takes Destination sheet name
'- creates pivot into new sheet
'- returns true if success

    Dim conADO        As Object
    Dim rstADO        As Object
    Dim pvtCache      As PivotCache
    Dim pvtTable      As PivotTable
    Dim rngPvtTarget  As range
    Dim strSQL        As String
    Dim strFileName   As String
    Dim str
Nick's picture

XLA routines: EE_MergeCSV

EE_MergeCSV merges 2 csvs...

Syndicate content