Formating with macro

[shekhu]

Hi all,

I use various macros in documentation though I am not acquainted with visual basic programming. I am using the following macro in the Microsoft Windows XP word document to do certain default changes. My issue is that I want to include the formatting part to this macro (such as bold, enter, tab etc.). Please suggest what changes I have to do in the following code or I have to use a different code altogether.

Sub FRUsingArrays()
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("date of birth", "date of visit", "history the patient", "social history", "primary care physician")
ReplaceArray = Array("DATE OF BIRTH:", "DATE OF VISIT:", "HISTORY: The patient", "SOCIAL HISTORY:", "PCP:")
Set myRange = ActiveDocument.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
.Replacement.Text = pReplace
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub


To make it a little bit more clear, let me explain it again.

First of all, I want a single macro to do all this, doesn't matter if we make multiple macros run one after other.

Secondly, the documents what i get has the text as below:

"date of birth 08/10/60 date of visit 08/24/10 history the patient"

and I want the text to be converted to as follows:


DATE OF BIRTH:[tab]08/10/60

DATE OF VISIT:[tab]08/24/10

HISTORY:[tab]The patient



I hope it is fairly clear now. Please suggest if it is posible with the current macro with slight modification or I have to use a totally different one. Thanks for your suggestion.

[gmaxey]

Sure it can be done. Sub FRUsingArrays()
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("date of birth ", "date of visit ", "history ")
ReplaceArray = Array("DATE OF BIRTH:", "DATE OF VISIT:", "HISTORY:")
Set myRange = ActiveDocument.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
If i = 0 Then
.Replacement.Text = pReplace & vbTab
Else
.Replacement.Text = vbCr & pReplace & vbTab
End If
.Replacement.Font.Bold = True
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

[shekhu]

Greg thats great. Thanks for that one. Greg, but this alone will not solve the issue. As the above code will do all the three (paragraph, bold, and tab). It would be even greater if you could explain to me that:
1. If I only want paragraph before or after a word, and not other formatting.
2. If I only want bold words, and not other formating.
3. If I only want tab before or after words, and not other formating.
So that I might customize the code depending on my formatting needs in different situations.
Thanks again buddy.

[gmaxey]

.Replacement.Font.Bold = True

Makes the replacement text bold.

vbCr &

Adds a paragraph before to the replacement text

& vbTab

Adds a tab after to the replacement text

[fumei]

If you want that level of customizing, you need to spell out EXACTLY what it is you want to do. Certainly this kind of stuff is very do-able, you just need to be specific about what it is you want to do.

You may gain a lot if you do some research on using Styles.

[shekhu]

Hello Greg and Fumei, Thanks for your cooperation.
Actually, I am in need of a macro that can format the text in a document (the text I get is written without any type of formatting).
"date of birth 08/10/60 date of visit 08/24/10 history the patient"

Initially I thought a single code will do this, but now what I gather is that I need different macros doing each one of these, i.e., bold, tab, and paragraph. This will be done by using the following feature to the original macro I had posted.
Application.Run MacroName:="OnlyBold"
Application.Run MacroName:="OnlyTab"
Application.Run MacroName:="OnlyParagraph"
Next
End Sub

This way four macros could be run at a single click
OnlyBold - This will bold the text with "find and replace" where I need to bold the text.
OnlyTab - This will put a Tab after or before a word with "find and replace."
OnlyParagraph - This will put a paragraph after or before a word with "find and replace."
I hope this will make it clear what I need to do actually. Please suggest if something else can be done.
Sunil

[gmaxey]

Well actually one procedure can do the job and what that job does depends on how you call it:


Sub CallTheMacro()
FRUsingArrays True, True, True
End Sub

Sub FRUsingArrays(ByRef bBold As Boolean, bTab As Boolean, bPar As Boolean)
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("date of birth ", "date of visit ", "history ")
ReplaceArray = Array("DATE OF BIRTH:", "DATE OF VISIT:", "HISTORY:")
Set myRange = ActiveDocument.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
Select Case True
Case bTab And bPar
If i = 0 Then
.Replacement.Text = pReplace & vbTab
Else
.Replacement.Text = vbCr & pReplace & vbTab
End If
Case Not bTab And bPar
If i = 0 Then
.Replacement.Text = pReplace & " "
Else
.Replacement.Text = vbCr & pReplace & " "
End If
Case bTab And Not bPar
.Replacement.Text = pReplace & vbTab
End Select
If bBold Then
.Replacement.Font.Bold = True
Else
.Replacement.Font.Bold = False
End If
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
Next
End Sub


Called with all arguments True does all three.

[shekhu]

I understand this is not that simple as it sounds. I hope the attached document will make it further clear what I am looking for.

Sunil

[gmaxey]

The formatting piece of your problem is vastly compounded by the repeated use of "history" and the use of the same word in both the category and the text e.g., impression impression.

Conceding that you are working for doctors and that they may not be open to a change formart, still it might be easier to revise the input format than it will be to try to wring the desired result out of what you get.

[gmaxey]

On second thought, try:

Option Explicit
Sub CallTheMacro()
FRUsingArrays True, False, True
End Sub
Sub FRUsingArrays(ByRef bBold As Boolean, bTab As Boolean, bPar As Boolean)
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("office visit note", "patient name ", "date of visit ", "date of birth ", _
"primary care physician", "history ", "current medications ", "allergies ", _
"family history ", "review of systems ", "social history ", "impression")
ReplaceArray = Array("OFFICE VISIT NOTE", "PATIENT NAME:", "DATE OF VISIT:", _
"DATE OF BIRTH:", "PCP:", "HISTORY:", "CURRENT MEDICATIONS:", _
"ALLERGIES:", "FAMILY HISTORY:", "REVIEW OF SYSTEMS:", _
"SOCIAL HISTORY:", "IMPRESSION:")
Set myRange = ActiveDocument.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
Select Case True
Case bTab And bPar
If i = 0 Then
.Replacement.Text = pReplace
Else
.Replacement.Text = "^p" & pReplace & vbTab
End If
Case Not bTab And bPar
If i = 0 Then
.Replacement.Text = pReplace
Else
.Replacement.Text = "^p" & pReplace & " "
End If
Case bTab And Not bPar
.Replacement.Text = pReplace & vbTab
End Select
If bBold Then
.Replacement.Font.Bold = True
Else
.Replacement.Font.Bold = False
End If
.MatchWholeWord = True
.Execute Replace:=wdReplaceOne
myRange.Collapse wdCollapseEnd
End With
Next
ActiveDocument.Paragraphs(1).Alignment = wdAlignParagraphCenter
End Sub

[shekhu]

Thanks Greg, but why it is not working on the following document :think:

[gmaxey]

Because that document is not formatted like the one you attached previously.
No one is going to be able to give you a macro that does what you want if you continue to change what you want during the process.

I feel that I have already shown you enough for you to apply what you now have to other situations.

[shekhu]

I am sorry Greg, that made you annoyed.
Firstly, at the beginning I myself was not sure what possibly could be done for a situation like mine.
Secondly, if I had originally posted everything it would have been very confusing.
Thirdly, I an not at all literate as far as VBA is concerned. I just try to manage the codes and try to make slight changes in codes whenever the need arises or suggested by someone. Rest all is luck.

Sunil

[gmaxey]

shekhu,

I am not annoyed. I simply spent a lot of time writing code for one situation that may or may not work in another. The problem I think you face is convinincing your doctors to dictate in a set manner. Once that manner is defined then you could most likely develop a macro that would format the text provided to you.

[fumei]

"Once that manner is defined then you could most likely develop a macro that would format the text provided to you."

Precisely.

As I stated: "If you want that level of customizing, you need to spell out EXACTLY what it is you want to do. Certainly this kind of stuff is very do-able, you just need to be specific about what it is you want to do."

Can you create code to make multiple changes in text formatting? Yes, absolutely. You have to define your requirements. A key issue is HOW are you getting the decision to do X, rather than Y. To bold this text, and not that; to add a Tab, or not. You need to work on getting the decision making into your code.

There are two decision-making aspects.

1. the user. A decision made whereby (for example) the user selects some text and is given a choice to do X (or Y...or both, or three);

2. you, the macro coder. These decisions are pre-defined. That is (for example):

IF "this text string" is found, THEN do this action.

[shekhu]

Thanks a lot Greg and Gerry for your cooperation.

As to let you know EXACTLY what I want: The fact is I get a prerecorded digital audio files and I get that through a voice recognition software. The document I had attached contains "I GET THIS" in the first part is the same. After that I propose to run a macro to do the maximum formatting that is possible. After running the macro we need to start the human editing effort. That is what I had planned. Also, adding that this is the one dictator I have started working on. Further, I need to work on other dictators also if this is successful (quite a big task) would certainly need help of an expert.

As far as templates are concerned we already have them, but we want to start from a scratch.
1. To open a new blank document.
2. Put in the transcript from the voice recognition software.
3. Run a macro that modify the page setup and customizes the formatting of the text put in, as per needs, and then start actual editing by a person.

For me this does part of the job:
Sub Aone()
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(office visit, family history, social history, past medical history, allergies, impression)
ReplaceArray = Array(OFFICE VISIT, FAMILY HISTORY , SOCIAL HISTORY , PAST MEDICAL HISTORY , ALLERGIES, IMPRESSION )
Set myRange = ActiveDocument.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
If i = 0 Then
.Replacement.Text = pReplace
Else
.Replacement.Text = vbCr & pReplace
End If
.Replacement.Font.Bold = True
.MatchWholeWord = True
.Execute Replace=wdReplaceAll
End With
Application.Run MacroName=Aone2
Next
End Sub

Sub Aone2()
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(data birth, date of birth , date of visit , cardiologist , primary care physician )
ReplaceArray = Array(DATE OF BIRTH , DATE OF BIRTH, DATE OF VISIT, CARDIOLOGIST, PCP)
Set myRange = ActiveDocument.Range
For i = LBound(SearchArray) To UBound(SearchArray)
pFind = SearchArray(i)
pReplace = ReplaceArray(i)
With myRange.Find
.Text = pFind
If i = 1 Then
.Replacement.Text = pReplace & vbTab
Else
.Replacement.Text = vbCr & pReplace & vbTab
End If
.Replacement.Font.Bold = True
.MatchWholeWord = True
.Execute Replace=wdReplaceAll
End With
Next
End Sub

Sunil

[Tinbendr]

The search/replace text must be in double quotes.


SearchArray = Array("office visit", "family history", "social history", "past medical history", "allergies, impression")


You need a colon here.

.Execute Replace:=wdReplaceAll

You need double quotes here too.
From this
Application.Run MacroName = "Aone2"
But you can just call it like this.
Aone2

Then, Greg's macro does a pretty good job.

[fumei]

And whoa, a good usage of styles may be in order.