How about
Code:
Public Function GetVariablesFirstLevel() As Collection
Dim objVar As Variable
Dim colAux As Collection
Dim strAux As String
Dim objStoryRange As Range
Dim i As Integer
Set colAux = New Collection
For Each objStoryRange In ActiveDocument.StoryRanges
With objStoryRange.Find
.ClearFormatting
Do While .Execute(findText:="- * -", MatchWildcards:=True)
'strAux = Trim(Replace(objStoryRange.Text, "-", ""))
strAux = objStoryRange.Text
colAux.Add strAux, UCase$(strAux)
objStoryRange.Collapse 0
Loop
End With
Next objStoryRange
'For i = 1 To colAux.Count
'Debug.Print colAux(i)
' Next i
GetVariablesFirstLevel = colAux
Set colAux = Nothing
Set objStoryRange = Nothing
Exit Function
End Function