Nick's blog

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
'    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
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
'    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
                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
'    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
'    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

'    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
'    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...
Nick's picture

XLA routines: EE_ExportSheetToXLS

EE_ExportSheetToXLS exports a worksheet to an XLS
Function EE_ExportSheetToXLS(strSheetName As String, strFilePath As String) As Boolean
'- takes a sheet name
'- takes a FullFilePath
'- creates new wb
'- delete existing file
'- sheet.copy (new wb)
'- saveas (FilePath)
'- close
'- returns True if success
    Dim wbkNew              As Workbook
    Dim strNewFullFilePath  As String
'    for updates on this function

    Set wbkNew = ActiveWorkbook
Nick's picture

XLA routines: EE_DateFileName

EE_DateFileName if a function that creates a date / time stamped file name in yyyymmdd format so that it can be sorted in Explorer
Function EE_DateFileName(strFileName As String, Optional varFileDate As Variant, Optional blnAddTime As Boolean) As String
'- takes a file name
' FileDate As Variant
' AddTime As Boolean
'- if date is missing, it appends today's date formatted as: '_yyyymmdd'
'- if AddTime is true, add 'hhmmss' of Now()
'- returns file name with appended date stamping
    Dim strNewFileName As String
Nick's picture

XLA routines: EE_ExportRangeToCSV

EE_ExportRangeToCSV creates a csv file from a range of data, and replaces errors.
Function EE_ExportRangeToCSV(strCSVfileName As String, rngExport As range, Optional blnDispMsg As Boolean = False) As Boolean
'-Takes a csv file name
'-deletes existing
'- converts all dates or times to longs - not implemented
'- exports CSV
' - if the cell contains an error (eg: #Value), it writes 'ERROR'
'- restores date time formatting - not implemented
'- returns True if success
    Dim wbkCSV              As Workbook
    Dim strCSVfullFilePath  As String
Nick's picture

XLA routines: EE_CheckPaths

EE_CheckPaths takes a range containing file paths, and checks to see if they all exist. - very useful at the start of a routine that depends on files existing. - check the paths and exit if they don't exist
Function EE_CheckPaths(rngPaths As range, Optional blnDispMissingMsg As Boolean = True) As Boolean
'- takes a range of cells containing file paths / folders.
'- checks if they exist
'- returns false if any 1 doesn't exist
'- displays messagebox with list of missing paths
    Dim strMissingPaths As String
    Dim rngEachPath As range
Nick's picture

XLA routines: EE_DeleteFile

EE_DeleteFile deletes a file if it exists.
Sub EE_DeleteFile(strFilePath As String, Optional blnShowMsg As Boolean = False)
'- takes file path
'- deletes file
'- does not error if file does not exist
'- does error if file is locked
'    for updates on this sub routine

    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(strFilePath) Then
            On Error Resume Next
                .deletefile strFilePath
                If Err.Number <> 0 And blnShowMsg = True Then
                    MsgBox Err.D
Nick's picture

XLA routines: EE_Copy

EE_Copy is one of the most used EE sub routines. Specify the source, and the top left of the target, and EE_Copy will copy the data over.
Nick's picture

XLA routines: EE_TableRemoveHeadings

EE_TableRemoveHeadings is a function that takes a table of data + headings and returns only the data
Function EE_TableRemoveHeadings(rngTable As range) As range
'- Takes an EE_table range
'- removes the headings
'- returns a range
'    for updates on this function

    Set EE_TableRemoveHeadings = Intersect(rngTable, rngTable.Offset(1))
End Function
Nick's picture

XLA routines: EE_TableFirstRowRange

EE_TableFirstRowRange is a simple function to return the first row of a table of data (the Headings)
Function EE_TableFirstRowRange(rngTable As range) As range
'- Takes an EE_Table Range
'- returns a range around the 1st Row in the table
'    for updates on this function

    Set EE_TableFirstRowRange = rngTable.Rows(1)
End Function
Nick's picture

XLA routines: EE_Find

The problem with Excel's "Find" routine is that it does not reset the Find criteria, so that when you use CTRL+F on the worksheet, you have to reset all the params. EE_Find gets around this by resetting the criteria. Returns a range object or nothing
Function EE_Find(strFind As String, rngRangeToFindIn As range) As range
'- takes a string, RangeToLookIn
'- returns a range of the first cell containing the string
'- uses .Find method, and looks for exact match, in whole cell
'- returns the 'exact match' checkbox back to unchecked

Nick's picture

XLA routines: EE_TableHeadingCol

EE_TableHeadingCol is a function that returns the column of a heading...
Nick's picture

XLA routines: EE_FilterAndRemove

EE_FilterAndRemove is a hugely useful VBA routine that uses sorting to remove large amounts of data from a table. Specify your table of data, the heading name, and the criteria. - designed to work well with vast amounts of data
Sub EE_FilterAndRemove(rngTable As range, strHeading As String, strCriteria As String)
    Dim rngTblData      As range
    Dim rngSortData     As range
    Dim intHeadCol      As Integer
'    for updates on this sub routine
    Set rngTblData = Intersect(rngTable, rngTable.Offset(1))
Nick's picture

XLA routines: EE_HideSheets

EE_HideSheets is a sub routine that hides any sheets that are not in the range of sheet names specified, or hides everything in the range if blnReverseSelection is true
Sub EE_HideSheets(ArrayOrRange, Optional blnReverseSelection As Boolean = False)
'> - takes an array or range
'> - Hide any sheets that are/not contained in the array\range
    Dim arr
    Dim intWksCount         As Integer
    Dim blnDelete           As Boolean
    Dim blnDelete2          As Boolean
    Dim wbk                 As Workbook
    Dim intShtAdded         As Integer
    Dim intShtAdded2        As I
Nick's picture

XLA routines: EE_ColorSheetTabs

EE_ColorSheetTabs is an easy sub that takes a range of coloured cells with sheet tab names in it. - colours the sheet tabs in accordance with the cell colour.
Sub EE_ColorSheetTabs(rngColor As range)
    Dim rngEach     As range
    Dim wbk         As Workbook
'    for updates on this sub routine
    Set wbk = ThisWorkbook
    For Each rngEach In rngColor
        On Error Resume Next
        wbk.Worksheets(rngEach.value).Tab.Color = rngEach.Interior.Color
        Err.Clear: On Error GoTo 0: On Error GoTo -1
Nick's picture

XLA routines: EE_SortTable

Sub routine that sorts a table using Excel 2007+ code. Needs to be extended to work with heading 2 and 3
Sub EE_SortTable(blnAscending As Boolean, wks As Worksheet, strFieldHeading As String)
'> - takes string of sheet name or wosksheet object, Heading1 string,
'> Ascending1 boolean...
Nick's picture

XLA routines: EE_AddCalculatedColumn

EE_AddCalculatedColumn is a hugely useful sub routine that adds a calculated column to your data set, and names it. - this saves writing the VBA to add a calculated column from your data set. Uses EE_GetLastPopulatedCell to find the last cell of the data
Sub EE_AddCalculatedColumn(rngColumn As range, strFormula As String, strNewHeading As String, Optional InChunksOf As Long)
    Dim rng As range
    With rngColumn
        Set rng = range(.Cells(2), .Cells(EE_GetLastPopulatedCell(rngColumn.Parent).
Nick's picture

XLA routines: EE_CloseOtherWorkbooks

Routine to close other workbooks - this saves setting variables and tracking open workbooks
Sub EE_CloseOtherWorkbooks(wbKeepOpen As Workbook)
'    for updates on this sub routine
' closes workbooks other than the workbook containing the code and another one specified
Dim wbk As Workbook
    On Error Resume Next
    For Each wbk In Application.Workbooks
        If wbk.Name <> ThisWorkbook.Name Then
            If Not wbKeepOpen Is Nothing Then
                If wbk.Name <> wbKeepOpen.Name Then
Nick's picture

XLA routines: EE_FileNameFromFilePath

Returns the file name from the file path
Function EE_FileNameFromFilePath(strFilePath As String) As String

    EE_FileNameFromFilePath = Mid(strFilePath, InStrRev(strFilePath, Application.PathSeparator) + 1)
End Function
Nick's picture

XLA routines: EE_HeadersCorrect

Often others deliver files to an application that need to have fixed col headers. Unfortunately, they often change them without telling you.
Nick's picture

XLA routines: EE_ApplyPivotDataFormatting

Takes a pivot table, and formats the pivot field based on a 2 col range
Sub EE_ApplyPivotDataFormatting(pt As PivotTable, FormattingRange As range)
'- takes a 2 col range, and applies the formatting specified in col 2 to the Data fields.
    Dim rngCell As range
    If FormattingRange.Rows.Count <> 2 Then Exit Sub
    For Each rngCell In FormattingRange.Rows
        pt.PivotFields(rngCell.Cells(, 1).value).NumberFormat = rngCell.Cells(, 2).value
    Next rngCell
    Set rngCell = Nothing
End Sub
Nick's picture

XLA routines: EE_SortTable2003Comp

Sort data using VBA in Excel.
Nick's picture

XLA routines: EE_GetLastPopulatedCell

Finds the last populated cell on a worksheet, or an empty cell representing the max row and max col.
Function EE_GetLastPopulatedCell(Optional wks As Worksheet) As Range
'-          Works how specialcells (lastCell)  SHOULD work
'-          Returns single cell range
    Dim lngCol      As Long
    Dim lngMaxRow   As Long
    Dim lngRow      As Long
    Dim lngMaxCol   As Long
' for updates on this function

    If wks Is Nothing Then
        Set wks = ActiveSheet
    End If
    If wks.UsedRange.Rows

Syndicate content