For future reference, I ran into exactly the same problem you did, and here is my solution. (I copied it directly from my app, so you will have to go through and take out what you don't need, in order to get it to work)
Public Function ApplyFilter()
On Error GoTo Trap
Dim Filtered As Boolean
Dim nd As Node
Dim arr() As String
With ModelNames
Select Case FilterBar.SelectedItem.Key
Case "UnCheckedModelsFilter"
ModelNames.Visible = False
FilterResults.Visible = False
FilterResults.Nodes.Clear
FilterResults.Visible = True
For Each nd In .Nodes
arr() = Split(nd.FullPath, "|")
Select Case UBound(arr())
Case 0
'node is root
CopyTVParentNode nd, FilterResults.Nodes, False
Case 1
'node is modelnamelevel
If UserFilter = "" Or IsUser(nd) Then
If IsModelChecked(nd) = False And nd.image <> 4 Then
CopyTVParentNode nd, FilterResults.Nodes, True
End If
End If
End Select
Next
Filtered = True
Exit Function
Case "QuestionsFilter"
ModelNames.Visible = False
FilterResults.Visible = False
FilterResults.Nodes.Clear
FilterResults.Visible = True
For Each nd In .Nodes
arr() = Split(nd.FullPath, "|")
Select Case UBound(arr())
Case 0
'node is root
CopyTVParentNode nd, FilterResults.Nodes, False
Case 1
'node is modelnamelevel
If UserFilter = "" Or IsUser(nd) Then
If IsModelQuestions(nd) = True And nd.image <> 4 Then
CopyTVParentNode nd, FilterResults.Nodes, True
End If
End If
End Select
Next
Filtered = True
Exit Function
Case "UnResolvedErrorsFilter"
ModelNames.Visible = False
FilterResults.Visible = False
FilterResults.Nodes.Clear
FilterResults.Visible = True
For Each nd In .Nodes
arr() = Split(nd.FullPath, "|")
Select Case UBound(arr())
Case 0
'node is root
CopyTVParentNode nd, FilterResults.Nodes, False
Case 1
'node is modelnamelevel
If UserFilter = "" Or IsUser(nd) Then
If IsErrorUnResolved(nd) = True And nd.image <> 4 Then
CopyTVParentNode nd, FilterResults.Nodes, True
End If
End If
End Select
Next
Filtered = True
Exit Function
Case "ResolvedErrorsFilter"
ModelNames.Visible = False
FilterResults.Visible = False
FilterResults.Nodes.Clear
FilterResults.Visible = True
For Each nd In .Nodes
arr() = Split(nd.FullPath, "|")
Select Case UBound(arr())
Case 0
'node is root
CopyTVParentNode nd, FilterResults.Nodes, False
Case 1
'node is modelnamelevel
If UserFilter = "" Or IsUser(nd) Then
If IsFixed(nd) = True And nd.image <> 4 Then
CopyTVParentNode nd, FilterResults.Nodes, True
End If
End If
End Select
Next
Filtered = True
Exit Function
Case "Responses"
ModelNames.Visible = False
FilterResults.Visible = False
FilterResults.Nodes.Clear
FilterResults.Visible = True
For Each nd In .Nodes
arr() = Split(nd.FullPath, "|")
Select Case UBound(arr())
Case 0
'node is root
CopyTVParentNode nd, FilterResults.Nodes, False
Case 1
'node is modelnamelevel
If IsUser(nd) = True Then
If IsResponse(nd) = True And nd.image <> 4 Then
CopyTVParentNode nd, FilterResults.Nodes, True
End If
End If
End Select
Next
Filtered = True
Exit Function
Case "ByDate"
ModelNames.Visible = False
FilterResults.Visible = False
FilterResults.Nodes.Clear
FilterResults.Visible = True
For Each nd In .Nodes
arr() = Split(nd.FullPath, "|")
Select Case UBound(arr())
Case 0
'node is root
CopyTVParentNode nd, FilterResults.Nodes, False
Case 1
'node is modelnamelevel
If UserFilter = "" Or IsUser(nd) Then
If IsDate(nd) = True And nd.image <> 4 Then
CopyTVParentNode nd, FilterResults.Nodes, True
End If
End If
End Select
Next
Filtered = True
Exit Function
End Select
If UserFilter <> "" Then
ModelNames.Visible = False
FilterResults.Visible = False
FilterResults.Nodes.Clear
FilterResults.Visible = True
For Each nd In .Nodes
arr() = Split(nd.FullPath, "|")
Select Case UBound(arr())
Case 0
'node is root
CopyTVParentNode nd, FilterResults.Nodes, False
Case 1
'node is modelnamelevel
If IsUser(nd) = True Then
CopyTVParentNode nd, FilterResults.Nodes, True
End If
End Select
Next
Filtered = True
End If
If Not Filtered Then
ModelNames.Visible = True
FilterResults.Visible = False
End If
End With
Exit Function
Trap:
Select Case MsgBox(Err.Description, vbAbortRetryIgnore, Err.Number)
Case vbAbort
Exit Function
Case vbRetry
Stop
Resume
Case vbIgnore
Resume Next
End Select
End Function
Private Sub CopyTVParentNode(nodeParent As Node, nodesDest As Nodes, Optional AddChildren As Boolean = True, Optional SkipParent As Boolean)
On Error GoTo Trap
Dim nodeDummy As Node
Dim nodeChild As Node
If Not SkipParent Then
If (nodeParent.Parent Is Nothing) Then
Set nodeDummy = CopyNode(nodeParent, nodesDest)
Else
Set nodeDummy = CopyNode(nodeParent, nodesDest, nodesDest(nodeParent.Parent.Key))
End If
End If
If AddChildren Then
Set nodeChild = nodeParent.Child
Do While Not (nodeChild Is Nothing)
If nodeChild.Children Then
Call CopyTVParentNode(nodeChild, nodesDest, True)
Else
Set nodeDummy = CopyNode(nodeChild, nodesDest, nodesDest(nodeChild.Parent.Key)) ', nodeDummy)
End If
Set nodeChild = nodeChild.Next
Loop
End If
Exit Sub
Trap:
Select Case MsgBox(Err.Description, vbAbortRetryIgnore, Err.Number)
Case vbAbort
Exit Sub
Case vbRetry
Stop
Resume
Case vbIgnore
Resume Next
End Select
End Sub
Private Function CopyNode(nodeSrc As Node, nodesDest As Nodes, Optional nodeParent As Node) As Node
On Error GoTo Trap
'On Error Resume Next
With nodeSrc
If (.Parent Is Nothing) Then
Set CopyNode = nodesDest.Add(, , .Key, .Text, .image, .SelectedImage)
CopyNode.BackColor = nodeSrc.BackColor
CopyNode.Tag = nodeSrc.Tag
If CopyNode.image = 4 Then
CopyNode.Expanded = False
Else
CopyNode.Expanded = True
End If
Else
If (nodeParent Is Nothing) Then
Set CopyNode = nodesDest.Add(.Parent.index, _
tvwChild, .Key, .Text, .image, .SelectedImage)
CopyNode.BackColor = nodeSrc.BackColor
CopyNode.Tag = nodeSrc.Tag
If CopyNode.image = 4 Then
CopyNode.Expanded = False
Else
CopyNode.Expanded = True
End If
Else
Set CopyNode = nodesDest.Add(nodeParent, _
tvwChild, .Key, .Text, .image, .SelectedImage)
CopyNode.BackColor = nodeSrc.BackColor
CopyNode.Tag = nodeSrc.Tag
If CopyNode.image = 4 Then
CopyNode.Expanded = False
Else
CopyNode.Expanded = True
End If
End If
End If
End With
Exit Function
Trap:
Select Case MsgBox(Err.Description, vbAbortRetryIgnore, Err.Number)
Case vbAbort
Exit Function
Case vbRetry
Stop
Resume
Case vbIgnore
Resume Next
End Select
End Function