Sub EE_CopyFile(strFullFilePath As String, strTarget As String)
'http://excelexperts.com/xla-routines-eeCopyFile    for updates on this sub routine

    If EE_FileNameFromFilePath(strFullFilePath) = EE_FileNameFromFilePath(strTarget) Then
        'FileCopy strFullFilePath, strTarget
        Call CreateObject("Scripting.FileSystemObject").CopyFile(strFullFilePath, strTarget)
    Else
        'FileCopy strFullFilePath, strTarget & Application.PathSeparator & EE_FileNameFromFilePath(strFullFilePath)
        Call CreateObject("S

Sub EE_CellFlash(ByVal Target As range, Optional dblFlashColor As Double = 5287936)
'- takes a cell
'- changes the cell colour green for one second then back to original colour

    Dim dblColor                As Double
    Dim dblPattern              As Double
    Dim dblPatternColor         As Double
    Dim dblPatternColorIndex    As Double
    Dim dblThemeColor           As Double
    Dim dblTintAndShade         As Double
    Dim dblPatternTintAndShade  As Double
    Dim dblPatternThemeColor    As Double
    Dim dblChangeColor    

Sub EE_FinalFormatSheet(strSheetName As String)
'Takes a sheet name as string
'If sheet doesn't exist, exit sub
'Sub autofits the cols
'Selects A2
'Freezes Panes

'http://excelexperts.com/xla-routines-eeFinalFormatSheet    for updates on this sub routine

    Dim wksActive As Worksheet
 
    Set wksActive = ThisWorkbook.ActiveSheet
 
    If EE_SheetExists(strSheetName) = True Then
        With ThisWorkbook.Worksheets(strSheetName)
            .Cells.EntireColumn.A

Sub EE_FormatCols(rngSource As range, rngTarget As range)
    Dim rngTgtHdr   As range
    Dim rngHd       As range
    Dim rngFound    As range
    Dim rngData     As range
    Dim dblDataRows As Double
 
'http://excelexperts.com/xla-routines-eeFormatCols    for updates on this sub routine

    Set rngData = Intersect(rngTarget.CurrentRegion, rngTarget.CurrentRegion.Offset(1))
    Set rngTgtHdr = rngTarget.Rows(1)
 
    dblDataRows = rngData.Row

Sub EE_RefreshPivots(wbk As Workbook)
    Dim wks     As Worksheet
    Dim pvtTbl  As PivotTable
 
'http://excelexperts.com/xla-routines-eeRefreshPivots    for updates on this sub routine
    For Each wks In wbk.Worksheets
        On Error Resume Next
            For Each pvtTbl In wks.PivotTables
                pvtTbl.RefreshTable
                pvtTbl.Update
            Next pvtTbl
        Err.Clear: On Error GoTo 0: On Error GoTo -1
    Next wks
 
    Set wks = Nothing
    Set pvtTbl = Nothing
End Sub

Function EE_GetUnique(arrDupes As Variant) As Variant
    Dim objDict     As Object
    Dim intLoop     As Long
 
'http://excelexperts.com/xla-routines-eeGetUnique    for updates on this function

    Set objDict = CreateObject("Scripting.Dictionary")
    For intLoop = LBound(arrDupes, 1) To UBound(arrDupes, 1)
        objDict(arrDupes(intLoop, 1)) = 1
    Next intLoop
    EE_GetUnique = Application.Transpose(WorksheetFunction.Transpose(objDict.Keys))
 
    Set objDict = Nothing
End Function

Sub EE_CustomSort(rngTable As range, strFldName As String, strCustomSortOrder As String)
    Dim intCol As Integer
 
'http://excelexperts.com/xla-routines-eeCustomSort    for updates on this sub routine

    intCol = Application.WorksheetFunction.Match(strFldName, rngTable.Rows(1), 0)
 
    With rngTable.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Intersect(rngTable.Columns(intCol), rngTable.Columns(intCol).Offset(1)), _
            SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
 

Function EE_IsInArray(arr As Variant, valueToCheck As String, _
    Optional exactMatch As Boolean = True) As Boolean
 
    Dim wordList              As String
    Dim startPosition         As Long
    Dim nextCommaPosition     As Long
    Dim matchedTerm           As String
 
'http://excelexperts.com/xla-routines-eeIsInArray    for updates on this function

    If UBound(Filter(arr, valueToCheck)) > -1 Then
        wordList = Join(arr, ",")
        ' start from the allegedly matched term ....
        st

Function EE_ArrayCommonElements(array1 As Variant, _
                          array2 As Variant) As Variant
    Dim tempArray     As Variant
    Dim i             As Long
 
'http://excelexperts.com/xla-routines-eeArrayCommonElements    for updates on this function

    ' start with a single element
    ReDim tempArray(0)
 
    ' if element in first array exists in second array, keep it
    For i = LBound(array1) To UBound(array1)
        If EE_IsInArray(array2, CStr(array1(i))) Then  ' found!
        'i

Function EE_GetColElements(rngTableWithHeader As range, strColName As String) As Variant
    Dim intCol As Integer
    Dim rng As range
    Dim arr As Variant
    Dim arr2
 
'http://excelexperts.com/xla-routines-eeGetColElements    for updates on this function

    intCol = Application.WorksheetFunction.Match(strColName, rngTableWithHeader.Rows(1), 0)
 
    With rngTableWithHeader
        Set rng = Intersect(.Columns(intCol), .Columns(intCol).Offset(1))
        EE_GetColElements = rng
        If rngTableWith

Sub EE_SortTwoRangesOnCommonIds(rngTableWithHeader1 As range, rngTableWithHeader2 As range, strColName As String)
'a sub that takes 2 ranges of data, with a common unique ID, and sorts both sets
'of data so that the common IDs are at the top in the same row on both sheets, and the ones that
'don't match are at the bottom - this should be optimised so that it is very quick with huge amounts
'of data (500,000 rows)..
    Dim arr1            As Variant
    Dim a

Sub EE_ExtractColumnsFromFile(strSourceFile As String, strSrcSheet As String, rngHeadings As range, strTgtSheet As String, Optional blnDispMsg As Boolean = False)
    Dim rngTgt      As range
    Dim rngEach     As range
    Dim objConn     As Object
    Dim objRst      As Object
    Dim strSQL      As String
    Dim strFlds     As String
    Dim x           As Integer
 
'http://excelexperts.com/xla-routines-eeExtractColumnsFromFile    for updates on this sub routine

Sub EE_FilterAndCopyToNewSheet(rngTable As range, strHeading As String, strCriteria As String, strCopyToSheet As String, Optional blnAppendToExistingSheet As Boolean = True)
'- same as filter and remove, but instead copies results to a new sheet
'- replaces the sheet if it exists already
    Dim intHeadCol      As Integer
    Dim wksTgt          As Worksheet
    Dim wbk             As Workbook
    Dim rngData         As range
    Dim rngTgt          As range
 
'http://excelexperts

Sub EE_FilterAndMove(rngTable As range, strHeading As String, strCriteria As String, strCopyToSheet As String)
'http://excelexperts.com/xla-routines-eeFilterAndMove    for updates on this sub routine

   Call EE_FilterAndCopyToNewSheet(rngTable, strHeading, strCriteria, strCopyToSheet)
   Call EE_FilterAndRemove(rngTable, strHeading, strCriteria)
End Sub

Sub EE_RearrangeColumns(SourceSheet As Worksheet, ParamArray TargetHeadings() As Variant)
    Dim intHeadings     As Integer
    Dim intCol          As Integer
    Dim rngTable        As range
    Dim rngColCopy      As range
    Dim rngPaste        As range
 
'http://excelexperts.com/xla-routines-eeRearrangeColumns    for updates on this sub routine

    Set rngTable = EE_Table(CStr(TargetHeadings(LBound(TargetHeadings))), SourceSheet)
 
    For intHeadings = LBound(TargetHeadings) To UBound(TargetHeading

Private Function EE_GetCellCount(rng As range) As Double
    Dim dblRowCount     As Double
    Dim dblColCount     As Double
 
'http://excelexperts.com/xla-routines-eeGetCellCount    for updates on this function

    dblRowCount = rng.Rows.Count
    dblColCount = rng.Columns.Count
    EE_GetCellCount = dblRowCount * dblColCount
 
    dblRowCount = Empty
    dblColCount = Empty
End Function

Public Function EE_RangeSubtract(ByVal rng1 As range, ByVal rng2 As range) As range
    Dim rngSmall        As range
    Dim rngBig          As range
    Dim rngIntersect    As range
    Dim rngTopRows      As range
    Dim rngBtmRows      As range
    Dim rngLeftCols     As range
    Dim rngRightCols    As range
    Dim rngUnion        As range
    Dim strMsg          As String
 
'http://excelexperts.com/xla-routines-eeRangeSubtract    for updates on this function

    If rng1.Areas.Count > 1 Or rng2.Areas.Count > 

Function EE_Concatenate(rng As range, strDelimiter As String) As String
'-concatenates the cells in the range
'Returns string..

Function EE_RangeCommon(rng1 As range, rng2 As range) As range
'http://excelexperts.com/xla-routines-eeRangeCommon    for updates on this function
    Set EE_RangeCommon = Intersect(rng1, rng2)
End Function

Function EE_RangeUnion(rng1 As range, Optional rng2 As range, Optional rng3 As range, _
    Optional rng4 As range, Optional rng5 As range, Optional rng6 As range) As range
 
'http://excelexperts.com/xla-routines-eeRangeUnion    for updates on this function

    If rng2 Is Nothing Then
        Set EE_RangeUnion = rng1
    ElseIf rng3 Is Nothing Then
        Set EE_RangeUnion = Union(rng1, rng2)
    ElseIf rng4 Is Nothing Then
        Set EE_RangeUnion = Union(rng1, rng2, rng3)
    ElseIf rng5 Is Nothing The

Function EE_RangeTrim(rng As range) As range
'Returns a new range containing only the populated cells
'- use RangeTrim for all the date functions to prevent looping through the whole range.

    Dim rngC As range
 
'http://excelexperts.com/xla-routines-eeRangeTrim    for updates on this function

    If rng.Cells.Count = 1 Then
        If rng.value <> vbNullString Then
            Set EE_RangeTrim = rng
            Exit Function
        End If
    End If
    On Error Resume Next
 

Function EE_LastFridayOfMonth(dt As Date) As Date
'Takes a date, returns last friday.
    Dim intLoop     As Integer
    Dim dtLast      As Date
 
'http://excelexperts.com/xla-routines-eeLastFridayOfMonth    for updates on this function

    dtLast = EE_LastDayOfMonth(dt)
    Do While Weekday((dtLast - intLoop)) <> vbFriday
        intLoop = intLoop + 1
    Loop
 
    EE_LastFridayOfMonth = dtLast - intLoop
End Function

Function EE_BusinessDaysInDateRange(dt1 As Date, dt2 As Date, rngHolidays As range)
'Takes date 1, date 2 and works out the amount of business days between them
'- takes range of holidays
    Dim intLoop         As Date
    Dim intDaysCount    As Integer
 
'http://excelexperts.com/xla-routines-eeBusinessDaysInDateRange    for updates on this function

    For intLoop = dt1 To dt2 Step IIf(dt1 > dt2, -1, 1)
        If EE_IsBusinessDay(rngHolidays, i

Function EE_LastBusinessDayOfMonth(dt As Date, rngHolidays As range) As Date
'- as above but rolls to the previous business day if the last bus day is a hol
'- also takes a range with the holiday calendar
'http://excelexperts.com/xla-routines-eeLastBusinessDayOfMonth    for updates on this function

    If EE_IsBusinessDay(rngHolidays, EE_LastDayOfMonth(dt)) Then
        EE_LastBusinessDayOfMonth = EE_LastDayOfMonth(dt)
    Else
        EE_LastBusiness

Function EE_LastDayOfMonth(dt As Date) As Date
'Takes a date and returns the last day of the month
'http://excelexperts.com/xla-routines-eeLastDayOfMonth    for updates on this function
    EE_LastDayOfMonth = DateAdd("d", -1, EE_FirstDayOfMonth(DateAdd("m", 1, dt)))
End Function

Function EE_FirstBusinessDayOfMonth(dt As Date, rngHolidays As range) As Date
'- as above but rolls to the next business day if the first bus day is a hol
'- also takes a range with the holiday calendar
'http://excelexperts.com/xla-routines-eeFirstBusinessDayOfMonth    for updates on this function

    If EE_IsBusinessDay(rngHolidays, EE_FirstDayOfMonth(dt)) Then
        EE_FirstBusinessDayOfMonth = EE_FirstDayOfMonth(dt)
    Else
        EE_FirstBusinessDayOfMonth = EE_NextBus

Function EE_FirstDayOfMonth(dt As Date) As Date
'Takes a date and returns the 1st day of the month
'http://excelexperts.com/xla-routines-eeFirstDayOfMonth    for updates on this function

    EE_FirstDayOfMonth = Format(Month(dt) & "/1/" & Year(dt), "mm/dd/yyyy")
End Function

Function EE_SubtractBusinessDays(dt As Date, rngHolidays As range, intBusinessDays As Integer) As Date
'Takes a date, a range of holidays, business days, and subtracts that amount of business days from the date.
    Dim intDays     As Integer
    Dim intLoop     As Integer
    Dim dtNew       As Date
 
'http://excelexperts.com/xla-routines-eeSubtractBusinessDays    for updates on this function

    If intBusinessDays = 0 Then
        EE_SubtractBusinessDays = dt

Function EE_AddBusinessDays(dt As Date, rngHolidays As range, intBusinessDays As Integer) As Date
'Takes a date, a range of holidays, business days, and adds that amount of business days to the date.