create severals filterlines

[thalos]

Hi !
The purpose of my macro is to remove all the lines that doesn't contain
these word AABB or thalos .

But nothing happens as soon as i play the macro ?Any help please .

Sub Main()

End Sub

Sub FilterLines(StrAABB As String, thalos As String)

StrAABB = "AABB"
thalos = "thalos"

Dim objWdOldRng As Range
Dim objWdRng As Range
'Goto the begining of the first line in the document
Selection.GoTo wdGoToLine, wdGoToFirst
'Exapand to select the entire line
Selection.Expand wdLine
'Get the Selected range and store it as objWdOldRng
Set objWdOldRng = Selection.Range
'Goto the Last Line in the document
Selection.GoTo wdGoToLine, wdGoToLast
'Exapand to select the entire line
Selection.Expand wdLine
'Get the Selected range and store it as objWdRng
Set objWdRng = Selection.Range
'Use InStr to check if the search string strWord is found in the Text
of objWdRng
'If it is NOT found it returns a 0

If ((InStr(objWdRng.Text, StrAABB) = 0) And
(InStr(objWdRng.Text, thalos) = 0)) Then
objWdRng.Delete
End If


'loop through the document from last line back to first line
Do
'Goto the previous line in the document
Selection.GoTo wdGoToLine, wdGoToPrevious
'Exapand to select the entire line
Selection.Expand wdLine
Set objWdRng = Selection.Range
If ((InStr(objWdRng.Text, Str11223344) = 0) And
(InStr(objWdRng.Text, thalos) = 0)) Then
objWdRng.Delete
End If
'DoEvents

'Keep on searching until current line = the first line
Loop Until objWdRng = objWdOldRng
End Sub

 

[thalos]

don't search I have found .Excuse me