Sub Test() Dim i As Long Dim myInfo As String Dim myRange As Range Dim rgeSave As Range Set rgeSave = Selection.Range Application.ScreenUpdating = False 'Loop: Do a Search, Then Execute Some Other Commands Inside 'a "Do Until End of Document" Loop (version 2, thanks to Shawn Wilson): Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "13" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Do While Selection.Find.Execute 'Do something within the found text myInfo = myInfo & Selection.Information(wdFirstCharacterLineNumber) & " " & Selection.Information(wdActiveEndAdjustedPageNumber) & " " Loop MsgBox myInfo Application.ScreenRefresh Application.ScreenUpdating = True rgeSave.Select End Sub