Find a bunch of text

[elmnas]

Hello all VBA guys,

i am struggling with a find and replace script

I want my macro to find in a document the word "Claims" then

mark all text to the next 2 linebreaks,


I've created a part of a code
which looks like this..






Sub Daniels_rws()
'
' Daniels_rws Makro
'
'
Windows("Wordfile_EP2488557.docx [kompatibilitetsläge]").Activate
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "claims"
.Font.Name = "Arial"
.Font.Bold = True

.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

End Sub



Please help me out

Thank you in advance,

[gmaxey]

Hello all VBA guys,

i am struggling with a find and replace script

I want my macro to find in a document the word "Claims" then

mark all text to the next 2 linebreaks,


I've created a part of a code
which looks like this..






Sub Daniels_rws()
'
' Daniels_rws Makro
'
'
Windows("Wordfile_EP2488557.docx [kompatibilitetsläge]").Activate
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "claims"
.Font.Name = "Arial"
.Font.Bold = True

.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

End Sub



Please help me out

Thank you in advance,

Try something like this:


Sub Test()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "Claims"
While .Execute
oRng.MoveEndUntil Chr(11)
oRng.MoveEnd wdCharacter, 1
oRng.MoveEndUntil Chr(11)
oRng.HighlightColorIndex = wdBrightGreen
oRng.Collapse wdCollapseEnd
Wend
End With
End Sub

[elmnas]

Try something like this:


Sub Test()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "Claims"
While .Execute
oRng.MoveEndUntil Chr(11)
oRng.MoveEnd wdCharacter, 1
oRng.MoveEndUntil Chr(11)
oRng.HighlightColorIndex = wdBrightGreen
oRng.Collapse wdCollapseEnd
Wend
End With
End Sub


Thank you,

works like a charm! how do I add in the code the macro copy the text ?