unable to make this script work - vba

Question

i am trying to find all bold and then change their formatting so i am trying to do it with two loops one for find bold words and then other for changing formatting. can someone please tell me how to do it/ any help is much appreciated.
'thank you
Sub SearchBoldText()
Dim rng As Range
Set rng = ThisDocument.Range(0, 0)
With rng.Find
.ClearFormatting
.Format = True
.Font.Bold = True
While .Execute
rng.Select
rng.Collapse direction:=wdCollapseEnd
Wend
Do Until rng = 0
With Selection.Font
.Name = "Times New Roman"
.Size = 20
.Bold = True
.Color = RGB(200, 200, 0)
End With
Selection.Find.Execute
Loop
End With
End With
Set rng = Nothing
End Sub

Answer 1

There is no need of 2 loops for this matter. Let's say your range is A1 to F40, do as follow. Note that i didn't change the formatting but I've made the cell's background red. You could adjust to your needs.
For EXCEL :
Sub SelectBold()
Dim Rng As Range
Dim WorkRng As Range
Set WorkRng = Range("A1:F40")
For Each Rng In WorkRng
If Rng.Font.Bold Then
Rng.Interior.Color = RGB(255, 0, 0)
End If
Next
End Sub
For WORD:
Sub findBold()
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Size = 20
Selection.Find.Replacement.Font.ColorIndex = wdYellow
Selection.Find.Replacement.Font.Name = "Times New Roman"
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub