PDA

View Full Version : Loop until not found


egran2ca
03-05-2012, 08:56 PM
I know that what I've done is very crude coding, but it does what I want and I understand it (important for me).

I am working with long documents containing newspaper articles, and this adds tags to identify the headlines. It finds a headline, which is in 14 pt Bold type, and adds the opening tag. The second 'find' selects the same headline, removes the Bold, and then adds the closing tag. (Sometimes a headline is several lines long and this is a simple way of selecting all of it.)

Now I need it to Loop until it no longer finds any 14pt Bold text.

I just can't seem to get the Loop commands, so I'm once again asking for help.

Thanks,
Eleanor



Sub AddTags()
'
' Add tags to ID headlines
'
'
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 14
.Bold = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.TypeText Text:="<head>"
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 14
.Bold = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
End With
Selection.Find.Execute
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</head>"


End Sub
Talis
03-06-2012, 12:02 PM
Here's a starting point which the experts will no doubt improve:
Sub Head()
With ActiveDocument.Range.Find
.ClearFormatting
.Font.Bold = True
.Font.Size = 14
.Text = "([!^13]@)^13"
.MatchWildcards = True
.Replacement.ClearFormatting
.Replacement.Text = "<head>" & "\1" & "</head>" & "^p"
.Replacement.Font.Bold = False
.Forward = True
.Execute Replace:=wdReplaceAll
End With
End Sub

You say "(Sometimes a headline is several lines long and this is a simple way of selecting all of it.)" and this will cause the above subroutine to fail if the lines are separated by paragraph returns and you only want one <head> at the start of the sequence of lines and one </head> at the end.
egran2ca
03-06-2012, 12:36 PM
I thought I had this solved with the revised macro below. It seemed to work when I was testing it, but now it won't run at all. There's no error message to indicate a coding error.

Talis, thank you. Your reply arrived while I was composing this message. I'm having the same problem - your code won't run. My base macro, i.e. without the Do While/Loop command does run.

I really don't understand what's going on!!

Thanks,
Eleanor

PS: I've attached a sample of the type of file I'm working with.

AddTags2()
'
' Add tags
'
'
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 14
.Bold = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True

End With
Do While Selection.Find.Found
Selection.Find.Execute
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="<head>"
Selection.MoveDown Unit:=wdParagraph, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</head>"
Loop
End Sub
Talis
03-06-2012, 01:05 PM
You're starting off with Selection, so have you selected anything?
fumei
03-06-2012, 01:11 PM
Maybe use Range, rather than Selection?
egran2ca
03-06-2012, 02:44 PM
To answer fumei: I record a macro because I don't know how to write code and the recorded macro uses selection.

To answer Talis: the following macro selects the next instance of text formatted as 14pt Bold. It then removes the Bold and adds the tags either end.

What I need it to do is Loop until no further Bold text is found or until end of file.

Thanks,
Eleanor

Sub HeadlineTag()
'
' Add tags to headline
'
'

Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 14
.Bold = True
End With

With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With

Selection.Find.Execute
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="<head>"
Selection.MoveDown Unit:=wdParagraph, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</head>"

End Sub
fumei
03-06-2012, 03:08 PM
Look up using a Do...While.
Paul_Hossler
03-06-2012, 03:22 PM
I'd do it it 2 passes.

The paragraph mark in your sample document is not in BOLD, so any search that looks for bold, 14 text + a paragraph mark will fail

This is probably a little brute force since it does one bold char at a time, but I couldn't come up with a reliable way that didn't depend on the paragraph mark being Bold, 14


Option Explicit
Sub Test()

Application.ScreenUpdating = False

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting

With .Font
.Size = 14
.Bold = True
End With

'first pass
.Text = "*"
.Replacement.Text = "<head>^&</head>"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll

'second pass
.Text = "</head><head>"
.Replacement.Text = vbNullString
.MatchWildcards = False

.Execute Replace:=wdReplaceAll

.ClearFormatting
.Replacement.ClearFormatting


End With

Application.ScreenUpdating = True

End Sub



Paul
egran2ca
03-06-2012, 03:56 PM
I do not understand this at all, but if I run the macro without the loop once (Macro1) so that it tags the first headline, and then run the macro with the loop (Macro2), it works and tags the rest of the headlines in the file.

Macro1
Sub HeadlineTag()
'
' Add tags to next headline
'

Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 14
.Bold = True
End With

With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With


Selection.Find.Execute
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="<head>"
Selection.MoveDown Unit:=wdParagraph, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</head>"

End Sub
Macro2
Sub AddTags2()
'
' Add tags to remaining headlines in document
'
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 14
.Bold = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With
Do While Selection.Find.Found
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="<head>"
Selection.MoveDown Unit:=wdParagraph, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="</head>"
Selection.Find.Execute
Loop
End Sub
egran2ca
03-06-2012, 04:05 PM
Paul - thank you!! This works perfectly. Now I don't have to run 2 macros.
Talis
03-06-2012, 04:24 PM
Here's another:
Sub formatHead()
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Font.Size = 14
.Font.Bold = True
.Text = ""
.Replacement.Text = ""
End With
Do While Selection.Find.Execute = True
Selection.Font.Bold = False
While Selection.Characters.Last = " " Or Selection.Characters.Last = vbCr
Selection.MoveEnd Unit:=wdCharacter, Count:=-1
Wend
Selection.InsertBefore "<head>"
Selection.InsertAfter "</head>"
Selection.MoveRight wdCharacter, 1
Loop
End Sub
Paul_Hossler
03-06-2012, 04:44 PM
Paul - thank you!! This works perfectly. Now I don't have to run 2 macros.

Not a problem -- I'm always worried about the performance penalty when you use any kind of VBA loop so I try to go that route last

This time it was easy to do a Find and Replace

Paul
egran2ca
03-06-2012, 08:15 PM
[quote=Talis]Here's another:
...snip

Thanks Talis. Now I have a choice!
macropod
03-06-2012, 10:40 PM
Talis: using Selection! spit, spit! blech
For some real efficiency & speed, try:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Integer
With ActiveDocument.Range
With .Find
.ClearFormatting
.Text = ""
.Font.Size = 14
.Font.Bold = True
.Replacement.ClearFormatting
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Execute
End With
Do While .Find.Found
i = i + 1
With .Duplicate
.Font.Bold = False
While .Characters.Last = " " Or .Characters.Last = vbCr
.End = .End - 1
Wend
.Text = "<head>" & .Text & "</head>"
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub
fumei
03-07-2012, 12:34 AM
or...Sub MakeHead()
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
.Font.Bold = True
.Font.Size = 14
Do While .Execute(Forward:=True) = True
With r
.Text = "<head>" & r.Text
.Collapse direction:=wdCollapseEnd
.MoveEnd unit:=wdCharacter, Count:=-1
.InsertAfter ("</head>")
.Collapse direction:=wdCollapseEnd
.Move unit:=wdCharacter, Count:=1
End With
Loop
End With
End Sub
macropod
03-07-2012, 05:01 AM
Hi Gerry,

.MoveEnd unit:=wdCharacter, Count:=-1
Unless the bold attribute extends to the following white space/paragraph break/line break, that puts </head> within the bold text.
Talis
03-07-2012, 11:19 AM
@Macropod
Check out #2
It works fine for me, but the op wanted something using 'Selection' so I obliged, as did Paul_Hossler.
fumei
03-07-2012, 01:50 PM
Actually the OP did not state they wanted something using Selection. They used Selection because:


I record a macro because I don't know how to write code.


And yes of course macropod is correct.
Paul_Hossler
03-07-2012, 02:08 PM
... as did Paul_Hossler.


That would make me suspcious right there :doh:

Paul