Function EE_TableFreeHeading(sht As Worksheet) As Range
'http://excelexperts.com/xla-routines-eeTableFreeHeading    for updates on this function
' finds the next free cell to the right of a table
    
    Set EE_TableFreeHeading = sht.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
 
End Function

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 transposes onto a new sheet
'http://excelexperts.com/xla-routines-eeExtractRow    for updates on this sub routine

    If SourceSht Is Nothing Then
        Set SourceSht = ActiveSheet
    End If
 
    If wb Is Nothing Then
        Set wb = ActiveWorkbook

Sub EE_ReplaceErrors(Optional rng As Range, Optional ReplaceWith As String)
'http://excelexperts.com/xla-routines-eeReplaceErrors    for updates on this sub routine
' takes a range and replace the errors in the range

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

Sub EE_AddTableCalculatedColumn(Header As String, Formula As String)
'http://excelexperts.com/xla-routines-eeAddTableCalculatedColumn    for updates on this sub routine
' adds a calculated column to a table on the activesheet
Dim HeaderCol As Long
Dim myData  As Range
 
    If Cells(1).CurrentRegion.Rows.Count = 1 Then Exit Sub ' no data
    Set myData = EE_TableGetColumnData(Header)
    myData.ClearContents
    HeaderCol = EE_TableHeadingCol(Header)
    Cells(2, HeaderCol) = Formula
    myData.value = myData.value

Sub EE_FormatCols(rngSource As Range, Optional rngTarget As Range)
'http://excelexperts.com/xla-routines-eeFormatCols    for updates on this sub routine
' takes a source range containing the heading and format in 2 cols
' looks in the target range and formats the target range
Dim rngHd As Range
Dim rngFound As Range
 
    Call EE_Start
 
    Set rngTarget = EE_TableDefault(rngTarget).Rows(1)
    For Each rngHd In rngSource.Rows
        Set rngFound = rngTarget.Find(rngHd.Cells(1).value, , xlValues, xlWhole)
 

Sub EE_ReverseSignInRange(rng As Range)
'http://excelexperts.com/xla-routines-eeReverseSignInRange    for updates on this sub routine
' takes a range as input and reverses the sign of numbers in the range
' turns positive numbers negative and negative numbers positive
Dim theCell
 
    Set rng = Intersect(rng.Parent.UsedRange, rng)
    ' rng.select
    For Each theCell In rng
        If Application.IsNumber(theCell.value) Then
            theCell.value = theCell.value * -1
        End If
    Next
 
End Sub

Sub EE_ListSheetNames(Optional NewShtName As String)
'http://excelexperts.com/xla-routines-eeListSheetNames    for updates on this sub routine
' lists the names of the sheets on a new sheet
Dim sht As Worksheet
 
    If NewShtName = "" Then
        NewShtName = "Index"
    End If
 
    Call EE_ReplaceSheet(NewShtName)
    i = 1
 
    On Error Resume Next
    For Each sht In ActiveWorkbook.Sheets
        Cells(1).Offset(i) = sht.Name
 
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(1).Offset(i), Address:="", Sub

Sub EE_PivotTurnOffNonBlank(pvtField)
'http://excelexperts.com/xla-routines-eePivotTurnOffNonBlank    for updates on this sub routine
' turns off non-blank items from pivot table
' assumes 1 pivot on page, no error checking

    Dim pvtItem
 
    pvtField.CurrentPage = "(All)"
    pvtField.EnableMultiplePageItems = True
    For Each pvtItem In pvtField.PivotItems
        If pvtItem.Name = "(blank)" Then
                pvtItem.Visible = True
            Else
                pvtItem.Visible = False
        End If
    Next
 
End Sub

Function EE_PositionInRange(Header As String, rng As Range) As Long
'http://excelexperts.com/xla-routines-eePositionInRange    for updates on this function
' Takes a heading name, range
' returns the position in the range as long
' returns 0 if not found
    On Error Resume Next
    EE_PositionInRange = Application.WorksheetFunction.Match(Header, rng, 0)
    If Err.Number <> 0 Then
        EE_PositionInRange = 0
    End If
 
End Function

Function EE_TableDefault(Optional rngTable As Range) As Range
'http://excelexperts.com/xla-routines-eeEE_TableDefault    for updates on this function
' returns the currentregion around the first cell - a good guess for a table of data's range
    
    Set EE_TableDefault = rngTable
    If rngTable Is Nothing Then
        Set EE_TableDefault = ActiveSheet.Cells(1).CurrentRegion
    End If
 
End Function

Sub EE_PivotRemoveTotals(Optional pt As PivotTable)
'http://excelexperts.com/xla-routines-eePivotRemoveTotals  for updates on this routine
    If pt Is Nothing Then
        If ActiveSheet.PivotTables.Count = 0 Then Exit Sub
        Set pt = ActiveSheet.PivotTables(1)
    End If
 
    pt.RowGrand = False
    pt.ColumnGrand = False
End Sub