Repeat Macro

S

Steved

Hello from Steved

I have a document where I run the below macro

At the moment I run the macro several times

How do I have the macro below run without me having
to execute it each time as sometimes I may have to run it
up to 300 or more times in the same document.

Simply put how do I get it to run again automatically to
the end of the document please.

Thankyou.



Sub RaceDictionary()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^$^$"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Extend
Selection.HomeKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "\(*by"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=2,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeBackspace
Selection.TypeText Text:="= "
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.TypeText Text:=", "
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*$"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.TypeText Text:="X"
Selection.Extend
Selection.HomeKey Unit:=wdLine
Selection.Find.ClearFormatting
Selection.Find.Font.Size = 30
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
End Sub
 
D

Doug Robbins

I haven't tried to work out what you want this macro to do, but if it's the
same problem that you posted into the newusers newsgroup about converting

1. 7322x Prince Of Seville

7. 07x9x Symboli Rex

8. Lord Mellays Chief


to

Prince Of Seville

Symboli Rex

Lord Mellays Chief

See the response in that newsgroup.
--
Please respond to the Newsgroup for the benefit of others who may be
interested. Questions sent directly to me will only be answered on a paid
consulting basis.

Hope this helps,
Doug Robbins - Word MVP
 
S

Steved

Hello Doug from Steved

Below is what my objective is.
You macro gives me the Poker Face

Using my macro below will give the below result, in other
words I've been able to build it to do one at a time
hence when i've got to press the macro button each time
maybe up to 3 hundred times I thought about automating
the process, this is where your macro comes in, as now
your macro will do the lot but I would like to have it
so that it will do the below when I push the macro button
it does the whole lot in one session.

If you have time to try my macro at the bottom you will
see 3 under Innes make shore the font is 30 , by do that
you will see what I'm try to acheive.

Once again thankyou.


Poker Face= by Super Gray, $750

2. 6384 Poker Face (17) 4g br
Pentire (GB)-Gold Raider (G2P by Super Gray)
Leith Innes(56)
Stats:
Trnr: John Sargent (Matamata)
Ownr: W J Gleeson
All 4:0:0:1:1
Prz $750
F 1:0:0
E 2:0:1
S 1:0:0
H 0:0:0
C 0:0:0
D 0:0:0 F90 1:0:0:0
F30 1:0:0:0
2Up 1:0:0:1 Fav 0:0:0:0
2 Fav 1:0:0:0
Win $0.00
Plc $0.48
Perf: TAUP 18 Aug 2004 - 6 of 11 Mdn $5K 1800 F- Hayden
Tinsley 56 (9) 10/10 $22.95 1st: Stik To The Basics
1:51.99 3.9L
WAIK 08 Sep 2004 21 dys 3 of 11 Mdn $5K 2100 E3.0 Leith
Innes 56 (2) 3/4 $4.65 1st: Breeze Hill (IRE) 2:14.46 4L
RBPH 22 Sep 2004 14 dys 8 of 10 Mdn $5K 2200 S3.6 Leith
Innes 56 (8) 2/3 $4.70 1st: Dicktator 2:21.36 17.5L
PROA 03 Nov 2004 42 dys 4 of 15 Mdn $5K 2100 E2.8 Leith
Innes 56 (11) 9/8 $18.05 1st: Zalika 2:12.64 2.3L
-
3
 
S

Steved

Hello Doug form Steved
I've now incorporated your macro into mine and
I'm getting the below result, so we are getting there.

1. 8234x Dreamsize= by Nuage d'Or, $10,340
 
S

Steved

Hello Doug from Steved

Ok I've been working on your macro, and I've incorporated
it in mine. What I can now do thanks to you is push the
macro and it will go threw the whole document, which is
what I always havwe wanted, but I getiing the below
result.

1. 6328x Lyall Bay= by Kingdom Bay, $2,700
but need it to have the below result
Lyall Bay= by Kingdom Bay, $2,700

Can you kindly please direct me thankyou.

ps ignore the other replies.

Sub RaceDictionary()
Dim i As Long, j As Long, pararange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
Set pararange = ActiveDocument.Paragraphs(i).Range
For j = 1 To pararange.Characters.Count
If Asc(pararange.Characters(j)) > 64 And Asc
(pararange.Characters(j)) < 91 Then
pararange.End = pararange.Start + j - 1
pararange.Delete
Exit For
End If
With Selection.Find
.Text = "\(*by"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=2,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeBackspace
Selection.TypeText Text:="= "
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.TypeText Text:=", "
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*$"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.TypeText Text:="X"
Selection.Extend
Selection.HomeKey Unit:=wdLine
Selection.Find.ClearFormatting
Selection.Find.Font.Size = 30
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Next j
Next i
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Loop until end 1
Select Text to End of Footnote 9
Change a great number of words in word files, with a macro as short as possible. 5
Bug 12
If not found ignore 2
Macro to Select text from a point given to a specific word 2
Word macro that can call cells out of Excel for a find and replace 0
how can I make yes no option button required? 2

Top