Some programs like MS Project show the hierarchy structure when filtering (i.e. they "show ancestors"). Excel does not do this - it understands indents and grouping (outlining), but it filters things out based on the cell, and doesn't show the hierarchy from lines above.
Attached is a macro that is aware of the Excel Outlining (grouping). Note: You can create the groupings automatically from the indents or the spaces using the Indent Macros.
It needs to be added to the Sheet that you wish to have the AutoFilter on as it relies on Events.
A common example is you paste from MS Project to Excel, then filter the Resources. If you use this spreadsheet, you can show the hierarchy of the relevant tasks.
Private Sub Worksheet_Change(ByVal Target As range)
Dim KeyCells As range
Dim KeyColumn As Integer
Dim Criteria As String
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
' Assumes the row above the autofilter contains the criteria
Set KeyCells = AutoFilter.range.Offset(-1).Rows(1)
If Not Application.Intersect(KeyCells, range(Target.address)) Is Nothing Then
Debug.Print "-------------------------"
Debug.Print "Cell " & Target.address & " has changed."
' Work out which column number it is
Debug.Print "Column " & Target.Column & " has changed"
'Debug.Print "Autofilter first column:" & AutoFilter.range.Column
KeyColumn = Target.Column - AutoFilter.range.Column + 1
On Error GoTo finish
If Target.Value = "" Then
AutoFilter.range.AutoFilter field:=KeyColumn ' Clear the filter
Else
AutoFilter.range.AutoFilter field:=KeyColumn, Criteria1:="=*" & Target.Value & "*", Operator:=xlAnd
Call showAncestors(Target.Offset(1), Target.Value)
End If
End If
finish:
End Sub
Sub showAncestors(Optional start As range, Optional Criteria As String = "yes")
' Shows the ancestors based on a criteria
Dim rng As range
Debug.Print "-------------------------"
Set rng = start.Resize(AutoFilter.range.Rows.Count) ' Grow column to end
Debug.Print "range: " & rng.address
For i = 2 To rng.Rows.Count ' Go down rows, skipping header
' If rng(i) <> Criteria Then ' It doesn't match the criteria
' rng(i).EntireRow.Hidden = True ' Filter it out
' End If
If InStr(1, rng(i), Criteria) Then ' It matches the criteria
Debug.Print rng(i).address
indent = rng(i).EntireRow.OutlineLevel ' Save the level
For j = i - 1 To 2 Step -1 ' Check rows above to see if its less
If rng(j).EntireRow.OutlineLevel < indent Then
indent = rng(j).EntireRow.OutlineLevel ' Save this level
rng(j).EntireRow.Hidden = False ' Unhide this row as it's an ancestor
End If
Next
End If
Next
End Sub