Help me to Create a Macro

[Thejan Mendis]

hi,


Okkkkk here we go.. again


My source like this


Q1: In their study of behavior, evolutionary psychologists use the
principles of:

A1: Mutation selection

A2: Natural selection*

A3: Conflict

A4: Sleep deprivation


Q1: is the question number, then there will be tab and question...text....
then comes the 4 answers may be 5 or 6

the answer with (*) is the correct answer for that questions so it should
move to the start of the line. I want this thing to be format as follows


In their study of behavior, evolutionary psychologists use the principles
of:

Mutation selection

*Natural selection

Conflict

Sleep deprivation

****
See no question number or answer numbers and no more tabs and there are
around 150 questions and nothing but this type of questions in the document.
always asterisk has to move to the start of the paragraphs.

and the question format just like same as here in email


THEJAN

 

[Helmut Weber]

Hi Thejan,
this is part 1:
Sub Makro18()
'Part1
Selection.WholeStory
Selection.Collapse
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([QA][0-9]{1;3}:^t)(*^013)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Work on Part 2 is in progress.
Make a copy of your doc and try it out.
Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr$(64) & "t-online.de"
Word 97, NT4.0

 

[Helmut Weber]

Hi Thejan,
this is part 2:

Sub Part2()
Selection.WholeStory
Selection.Collapse
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "*^a"
.Replacement.Text = "^a"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
While Selection.Find.Found
Selection.Paragraphs(1).Range.InsertBefore "*"
Selection.WholeStory
Selection.Find.Execute Replace:=wdReplaceOne
Wend
Selection.WholeStory
Selection.Collapse
End Sub
Note: There are more efficient ways to do that, probably.
This is not a tested solution, but a hint into the,
possibly, right direction. Make a copy of your
doc before trying.
Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr$(64) & "t-online.de"
Word 97, NT4.0
IMPORTANT REMARK CONCERING PART 1.
REPLACE ";" by "," in the selection.find.text
as my solution is localized to germany!!!
";" and "," have to be swapped!

 

[Thejan Mendis]

Hi Weber,

thanks for your quick replay. immm.. but I am getting an error when I run
your part one..


error say .....

run time error 5560
find what text contain pattern match which is not valid


THEJAN

 

[Helmut Weber]

Note:
.Text = "([QA][0-9]{1;3}:^t)(*^013)" 'German version
.Text = "([QA][0-9]{1,3}:^t)(*^013)" 'English Version

Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr$(64) & "t-online.de"
Word 97, NT 4.0