Function EE_GetUsername() As String
'http://excelexperts.com/xla-routines-eeGetUsername    for updates on this function
    EE_GetUsername = Environ("username")
End Function

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

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

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

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()

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()"

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

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

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

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
 
'http://excelexperts.com/xla-routines-eeExportSheetToXLS    for updates on this function

    ThisWorkbook.Worksheets(strSheetName).Copy
    Set wbkNew = ActiveWorkbook
 
    strNewFu

Function EE_DateFileName(strFileName As String, Optional varFileDate As Variant, Optional blnAddTime As Boolean) As String
'- takes a file name
'
'Optional:
' 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
 
'http://excelexperts.com/xla-routines-eeDa

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
 
'http://excelexperts.com/xl

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
 
'http://excelexperts.com/xla-routines-

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
'http://excelexperts.com/xla-routines-eeDeleteFile    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

Function EE_TableRemoveHeadings(rngTable As range) As range
'- Takes an EE_table range
'- removes the headings
'- returns a range
'http://excelexperts.com/xla-routines-eeTableRemoveHeadings    for updates on this function

    Set EE_TableRemoveHeadings = Intersect(rngTable, rngTable.Offset(1))
End Function

Function EE_TableFirstRowRange(rngTable As range) As range
'- Takes an EE_Table Range
'- returns a range around the 1st Row in the table
'http://excelexperts.com/xla-routines-eeTableFirstRowRange    for updates on this function

    Set EE_TableFirstRowRange = rngTable.Rows(1)
End Function

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

'http://excelexperts.com/xla-routines-eeFind    

Sub EE_FilterAndRemove(rngTable As range, strHeading As String, strCriteria As String)
    Dim rngTblData      As range
    Dim rngSortData     As range
    Dim intHeadCol      As Integer
 
'http://excelexperts.com/xla-routines-eeFilterAndRemove    for updates on this sub routine
    Set rngTblData = Intersect(rngTable, rngTable.Offset(1))
    intHe

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

Sub EE_ColorSheetTabs(rngColor As range)
    Dim rngEach     As range
    Dim wbk         As Workbook
'http://excelexperts.com/xla-routines-eeColorSheetTabs    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

Sub EE_SortTable(blnAscending As Boolean, wks As Worksheet, strFieldHeading As String)
'> - takes string of sheet name or wosksheet object, Heading1 string,
'> Ascending1 boolean...

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).

Sub EE_CloseOtherWorkbooks(wbKeepOpen As Workbook)
'http://excelexperts.com/xla-routines-eeCloseOtherWorkbooks    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
 

Function EE_FileNameFromFilePath(strFilePath As String) As String
'http://excelexperts.com/xla-routines-eeFileNameFromFilePath

    EE_FileNameFromFilePath = Mid(strFilePath, InStrRev(strFilePath, Application.PathSeparator) + 1)
End Function

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
'http://excelexperts.com/xla-routines-eeapplypivotdataformatting
    
    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