Get the symbol contain names in word using macros

[pradeepraomusale]

I am new for word macros. Can you anyone please suggest to me how to write a code in macros for the below solution.

I need to get the text contains special symbols("-") in between text in the word document macros.

This is the table of content we are using in word, Each heading having serial number also

1 test1
2 test2
3 -  test3 -  
4 test4
5 -  test5 -  
6 test6
7 -  test7 -  
8 test8
9 -  test9 -  
10 test10
11 test11
12 -  test12 -  
13 test13
14 -  test14 -

the result should be need like

 -  test3 -  
 -  test5 -  
 -  test7 -  
 -  test9 -  
 -  test12 -  
 -  test14 -

This is the sample code I wrote but it not working it getting only single text "-" in the collection

Public Function GetVariablesFirstLevel() As Collection
On Error GoTo ErrorHandler
    Dim objVar As variable
    Dim colAux As Collection
    Dim strAux As String
    Dim objStoryRange As Range
    Dim forceExitLoop As Boolean
            
    Set colAux = New Collection
    For Each objStoryRange In ActiveDocument.StoryRanges
        objStoryRange.Select
        Selection.Collapse wdCollapseStart
        With Selection
            With .Find
                .ClearFormatting
                .Text = "-"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindStop
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            forceExitLoop = False
            Do While (.Find.Execute And Not forceExitLoop)
                strAux = Trim$(Replace$(Right(.Text, 1), vbCr, vbNullString))
                If (strAux <> vbNullString) Then
                    If (Not IsReplacementOfAVariable(strAux)) Then
                        colAux.Add strAux, UCase$(strAux)
                    End If
                Else
                    forceExitLoop = True
                End If
            Loop
        End With
    Next
    
    Set GetVariablesFirstLevel = colAux
    Set colAux = Nothing
    Set objStoryRange = Nothing
Exit Function
End Function