Macro to add Bold function to it

[shekhu]

Hi all,

I need the following macro replaces text as bold character, along with what it does presently, e.g., paragraph and tab. Also, is it possible that it bolds one part and leave the rest, i.e., history the patient changes to HISTORY: The patient
Please suggest what changes should I make to it.
Sub MacroBoldText()
Dim SearchArray As Variant
Dim ReplaceArray As Variant
Dim myRange As Range
Dim i As Long
Dim pFind As String
Dim pReplace As String
SearchArray = Array("reason for visit", "date of visit", "date of birth", "history the patient")
ReplaceArray = Array("^pREASON FOR VISIT:", "^pDATE OF VISIT:^t", "^pDATE OF BIRTH:^t", "^pHISTORY: The patient")
Set myRange = Selection.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
.Replacement.Text = pReplace
.MatchWholeWord = True
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

[shekhu]

Also, is there any character that we can put before and after a text to make it bold, .....just a thought.
HAPPY NEW YEAR

[fumei]

Technically, if you are using Selection, you do not need to also use range.
With myRange.Find

can be
With Selection.Find
so no real need for myRange. Generally it is indeed better to use a range, but all you are actioning is the Selection, then use Selection.

As for the bolding of part of the text, no, not easiy, and not the way you are doing this. And BTW, you have HISTORY bolded, does that mean you want DATE OF VISIT:, or DATE OF VISIT:?

You do not need the string variables pFind, and pReplace. You can use the array directly.
Sub MacroBoldText()
Dim SearchArray As Variant
Dim ReplaceArray As Variant
Dim myRange As Range
Dim i As Long

SearchArray = Array("reason for visit", "date of visit", "date of birth", "history the patient")
ReplaceArray = Array("^pREASON FOR VISIT:", "^pDATE OF VISIT:^t", "^pDATE OF BIRTH:^t", "^pHISTORY: The patient")
Set myRange = Selection.Range
For i = LBound(SearchArray) To UBound(SearchArray)
With myRange.Find
.Text = SearchArray(i)
.Replacement.Text = ReplaceArray(i)
.MatchWholeWord = True
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub
If you DO want to replace everything as bold, yes, that can be done easily. Just add
.Replacement.Font.Bold = True

[fumei]

Just to be a bit clearer, the reason you can not do a partial bolding (or one of the reasons), is that you are using wdReplaceAll. If you want to action only part of the replacement text you will have to loop through each .Found separately, actioning each one separately.

[Paul_Hossler]

I'd make 3 Find & Replace passes through the entire document. Bit brute force, but probably faster than processing text word at a time


Option Explicit
'reason for visit date of visit date of birth history the patient
Sub MacroBoldText()
Dim SearchArray As Variant
Dim ReplaceArray As Variant, ReplaceArray2 As Variant
Dim myRange As Range
Dim i As Long

Dim pFind As String
Dim pReplace As String

SearchArray = Array("reason for visit", "date of visit", "date of birth", "history the patient")
ReplaceArray = Array("^pREASON FOR VISIT:###", "^pDATE OF VISIT:###^t", "^pDATE OF BIRTH:###^t", "^pHISTORY:### The patient")
ReplaceArray2 = Array("REASON FOR VISIT:###", "DATE OF VISIT:###^t", "DATE OF BIRTH:###^t", "HISTORY:### The patient")

Set myRange = ActiveDocument.Range

'Pass 1 - replace text and add markers
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting

For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
.Replacement.Text = pReplace
.MatchWholeWord = True
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next

'pass 2 - use marked text and make just the text bold
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
For i = LBound(ReplaceArray2) To UBound(ReplaceArray2)
pFind = ReplaceArray2(i)
pReplace = "^&"
With myRange.Find
.Text = pFind
.Replacement.Text = pReplace
.Format = True
.MatchCase = True
.MatchWholeWord = False
.Replacement.Font.Bold = True
.MatchWholeWord = True
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next

'pass 3 - remove temporary markers
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
pFind = "###"
pReplace = vbNullString
With myRange.Find
.Text = pFind
.Replacement.Text = pReplace
.Execute Replace:=wdReplaceAll
End With
End Sub


There's some clean up and tweaking that can be done (e.g. some statements don't need to be a loop and executed each time)

Paul

[shekhu]

Thanks Gerry and Paul for your valuable suggestions. I was able to manipulate the two macros that could get me the desired result.

Sub FormattingMacro()
Call RepAllwithoutMessage
RepAllMacroBoldText
End Sub

Sub RepAllwithoutMessage()
Dim SearchArray As Variant
Dim ReplaceArray As Variant
Dim myRange As Range
Dim i As Long
Dim pFind As String
Dim pReplace As String
SearchArray = Array("history the patient", "date of visit")
ReplaceArray = Array("^pHISTORY: The patient", "^pDATE OF VISIT:^t")
Set myRange = Selection.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
.Replacement.Text = pReplace
.MatchWholeWord = True
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

Sub RepAllMacroBoldText()
Dim SearchArray As Variant
Dim ReplaceArray As Variant
Dim myRange As Range
Dim i As Long

SearchArray = Array("reason for visit", "^pDATE OF VISIT:", "^pHISTORY:")
ReplaceArray = Array("^pREASON FOR VISIT:", "^pDATE OF VISIT:", "^pHISTORY:")
Set myRange = Selection.Range
For i = LBound(SearchArray) To UBound(SearchArray)
With myRange.Find
.Text = SearchArray(i)
.Replacement.Text = ReplaceArray(i)
.MatchWholeWord = True
.Replacement.Font.Bold = True
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

[shekhu]

Hello Gerry and Paul

When I use the macro with the "standard insert of physical examination" I get error and asks to debug the macro. I dont know why it is happening. Probably the replace part is too large. Please suggest.
Sub RepAllMacroBoldText()
Dim SearchArray As Variant
Dim ReplaceArray As Variant
Dim myRange As Range
Dim i As Long

SearchArray = Array("reason for visit", "^pDATE OF VISIT:", "^pHISTORY:", "^pPhysical examination:")
ReplaceArray = Array("^pREASON FOR VISIT:", "^pDATE OF VISIT:", "^pHISTORY:", "^pPhysical examination: He looks well. Blood pressure - xxx/xx. Heart rate – xx bpm. Respirations – xx per minute. O2 saturation - xx%. Height – xx”. Weight – xxx lbs., up x lbs. Chest - clear. Cardiac – heart S1, S2, I/VI systolic murmur. Extremities – 1 to 2+ peripheral edema.")
Set myRange = Selection.Range
For i = LBound(SearchArray) To UBound(SearchArray)
With myRange.Find
.Text = SearchArray(i)
.Replacement.Text = ReplaceArray(i)
.MatchWholeWord = True
.Replacement.Font.Bold = True
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

[macropod]

Your 'Physical examination' replacement string is too long - the maximum length in 255 characters. Try:
ReplaceArray = Array("^pREASON FOR VISIT:", "^&", "^&", "^& He looks well. Blood pressure - A/B. Heart rate – HR bpm. Respirations – RX/min. O2 saturation - 02%. Height – XX”. Weight – YY lbs., up ZZ lbs. Chest - clear. Cardiac – heart S1, S2, I/VI systolic murmur. Extremities – 1 to 2+ peripheral edema.")

[shekhu]

Paul, what does "^&" mean and what difference does it makes. Would I be able to get results for "DATE OF VISIT" and "HISTORY".

[macropod]

"^&" means to use the Find string for the Replace string. If you look in Word's Find/Replace dialog box, under 'Special', you will see a range of codes for different Find/Replace options. I used the "^&" code and other changes to your final Replace string to get it under the 255 character limit.

[Paul_Hossler]

Also, are you sure that you would want to always replace with text that is so specific?

(" He looks well. Blood pressure - xxx/xx. Heart rate – xx bpm. respirations – xx per minute ............")

The other text to be bold and highlighted is only the data identification, like Date of Visit, etc.

Might want to consider just making the "Physical Exam" bold and highlighted

Paul

[gunny2k9]

With ActiveDocument.Content.Find
.ClearFormatting
.Font.Bold = False
With .Replacement
.ClearFormatting
.Font.Bold = True
End With
.Execute FindText:="Find Non Bold", ReplaceWith:="Replace Bold:", _
Format:=True, Replace:=wdReplaceAll
End With


i found that that code on the net a few weeks back and worked for me to find a word and replace it as bold

[macropod]

Hi gunny2k9,

That's all very well but, if you study what is being done here, you'll see that there is a series of expressions being bolded. The code you posted is just another way of expressing a bolding operation for a single expression.