Word VBA: find line and replace font - vba

Question

I've written a VBA Word Macro that read a .txt File, copy it and paste it in a Word document setting a new font.
All is working fine! Now I would like to highlight some specific lines with bold + italic font, but i cannot figure out a working solution.
The specific lines begins with a specific word (for example Simulation Nr.xxx) or they begin with some words but then they have a very long series of blank spaces (for example Turbine).
How can i solve the problem?
P.s.: here the working code that copy/paste the .txt file into a word document.
Sub ACTUS_Table_Converter()
Dim pName As String
Dim bDoc As Document
Dim AppPath, ThisPath As String
Dim Rng As Range
ThisPath = ActiveDocument.Path
pName = ActiveDocument.Name
With Dialogs(wdDialogFileOpen)
If .Display Then
If .Name <> "" Then
Set bDoc = Documents.Open(.Name)
AppPath = bDoc.Path
End If
Else
MsgBox "No file selected"
End If
End With
Call ReplaceAllxSymbolsWithySymbols
Call ChangeFormat
Selection.Copy
Windows(pName).Activate
Selection.Paste
Selection.Collapse
bDoc.Close savechanges:=False
End Sub
Sub ChangeFormat()
Selection.WholeStory
With Selection.Font
.Name = "Courier New"
.Size = 6
End With
End Sub
Sub ReplaceAllxSymbolsWithySymbols()
'Call the main "ReplaceAllSymbols" macro (below),
'and tell it which character code and font to search for, and which to replace with
Call ReplaceAllSymbols(FindChar:=ChrW(-141), FindFont:="(normal text)", _
ReplaceChar:=ChrW(179), ReplaceFont:="(normal text)")
Call ReplaceAllSymbols(FindChar:=ChrW(-142), FindFont:="(normal text)", _
ReplaceChar:=ChrW(178), ReplaceFont:="(normal text)")
Call ReplaceAllSymbols(FindChar:=ChrW(-144), FindFont:="(normal text)", _
ReplaceChar:=ChrW(176), ReplaceFont:="(normal text)")
Call ReplaceAllSymbols(FindChar:="°", FindFont:="(normal text)", _
ReplaceChar:="", ReplaceFont:="(normal text)")
End Sub
Sub ReplaceAllSymbols(FindChar As String, FindFont As String, _
ReplaceChar As String, ReplaceFont As String)
Dim FoundFont As String, OriginalRange As Range, strFound As Boolean
Application.ScreenUpdating = False
Set OriginalRange = Selection.Range
'start at beginning of document
ActiveDocument.Range(0, 0).Select
strFound = False
If ReplaceChar = "" Then
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = FindChar
.Replacement.Text = ReplaceChar
.Replacement.Font.Name = "Courier New"
.Replacement.Font.Size = 6
.MatchCase = True
End With
If Selection.Find.Execute Then
Selection.Delete Unit:=wdCharacter, Count:=2
Selection.TypeText ("°C")
End If
Else
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = FindChar
.Replacement.Text = ReplaceChar
.Replacement.Font.Name = "Courier New"
.Replacement.Font.Size = 6
.MatchCase = True
.Execute Replace:=wdReplaceAll
End With
End If
OriginalRange.Select
Set OriginalRange = Nothing
Application.ScreenUpdating = True
Selection.Collapse
End Sub

Answer 1

The following code should run over the document, looking for line starts with Simulation Nr. and replace the whole line font with bold and italic.
Sub ReplaceLinesStartWith()
Dim startingWord As String
'the string to search for
startingWord = "Simulation Nr."
Dim myRange As range
'Will change selection to the document start
Set myRange = ActiveDocument.range(ActiveDocument.range.Start, ActiveDocument.range.Start)
myRange.Select
While Selection.End < ActiveDocument.range.End
If Left(Selection.Text, Len(startingWord)) = startingWord Then
With Selection.Font
.Bold = True
.Italic = True
End With
End If
Selection.MoveDown Unit:=wdLine
Selection.Expand wdLine
Wend
End Sub
Note that I hardcoded the string to search for, you can set it as function argument instead.