Function EE_RangeChange(RangeToChange As range, StartRowOffset As Integer, StartColOffset As Integer, _
    EndRowOffset As Integer, EndColOffset As Integer, Optional MaxRows As Long, Optional MaxCols As Long) As range
' creates a new range based on resizing the existing range
' so If we add StartRowOffset =1, we move the star

Sub EE_ExtractRow(Optional SourceSht As Worksheet, Optional TargetSht As String, Optional RowToExtract As Long, Optional wb As Workbook, Optional blnTranspose As Boolean = True)
' takes the selected cell row as default
' copies and paste transpose onto a new sheet
' copies row and header onto sheet specified
'http://excelexperts.com/xla-routines-eeExtractRow    for updates on this sub

    If SourceSht Is Nothing Then
 

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 = 

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 xlPasteValues
    rngTarget.PasteSpecial xlPasteFormats
 
    Application.

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

Function EE_IsArray(varArgument As Variant) As Boolean
'- takes variant
'- returns whether it really is an array. (By checking whether theArray(1,1) exists)
'http://excelexperts.com/xla-routines-eeIsArray    for updates on this function

On Error GoTo IsNotArray
    EE_IsArray = True
    Dim temp
    temp = varArgument(1, 1)
    Exit Function
IsNotArray:
    EE_IsArray = False
End Function

Sub EE_ReplaceErrors(rng As range)
'Takes a range.. Replaces any cells containing errors with ""
'http://excelexperts.com/xla-routines-eeReplaceErrors    for updates on this sub routine

    On Error Resume Next
        rng.SpecialCells(xlCellTypeFormulas, 16).value = ""
    Err.Clear: On Error GoTo 0: On Error GoTo -1
End Sub

Sub EE_SaveIfMe(strUserName As String)
'Takes a username as string
'Looks to see if application.username or ee_getusername is the string..
'If yes, save the workbook.

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

    Select Case strUserName
    Case Application.UserName, EE_GetUsername
        ThisWorkbook.Save
    End Select
End Sub

Function EE_OpenFromTemp(strFullFilePath As String) As Boolean
'Takes a full file name and path
'Opens the same file but from temp path
'Returns false if unsuccessful
'http://excelexperts.com/xla-routines-eeOpenFromTemp    for updates on this function

    Call EE_CopyFile(strFullFilePath, Environ("Temp"))
    On Error Resume Next
        Workbooks.Open (Environ("Temp") & Application.PathSeparator & 

Function EE_CopyToTempIfDifferent(strFullFilePath As String) As Boolean
'Takes a full file name and path
'Copies it to temp dir (deleting existing file if it exists) Returns false if unsuccessful
'http://excelexperts.com/xla-routines-eeCopyToTempIfDifferent    for updates on this function

    On Error Resume Next
        Kill Environ("Temp") & Application.PathSeparator & EE_FileNameFromFilePath(strFullFilePath)
        Call EE_Copy

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