Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.MatchWildcards = False
.Text = ""
.Font.SmallCaps = True
.Replacement.Font.SmallCaps = False
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
.Font.AllCaps = True
.Wrap = wdFindStop
.Execute
End With
Do While .Find.Found = True
.Case = wdUpperCase
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
PPS: When posting about related topics, please keep the posts in the same thread. Threads merged.