I have recorded a macro in Word 2007 that finds a word, moves the cursor two lines up, inserts three '***', then highlights the line. It works on the first instance of the found word. I am struggling to get it to repeat throughout the document with all instances of the word I want it to find.
This is the output from my recorded macro. I need the actions to be repeated for each instance of "B,".
Sub HighlightNewItems()
'
' HighlightNewItems Macro
'
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "B,"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.TypeText Text:="***"
Selection.TypeParagraph
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdRed
Selection.Range.HighlightColorIndex = wdRed
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Try putting the following construct within your With.Selection.Find
Do While .Execute
'(logic that you want to apply after finding string)
Loop
In your case, your code would look like
Sub HighlightNewItems()
'
' HighlightNewItems Macro
'
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "B,"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.TypeText Text:="***"
Selection.TypeParagraph
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdRed
Selection.Range.HighlightColorIndex = wdRed
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
End With
End Sub
Related
I'm trying to select any bolded & underlined text in a paragraph (in Microsoft word 2016). I really just want to select the text so I can manipulate in various ways (which will constantly vary depending on my needs for that specific text), eg highlight, unbold, copy etc.
I created the below macro using the macro recorder feature and when I was doing it it worked perfectly. But when I subsequently ran the macro it highlighted the whole paragraph, as opposed to just the bolded & underlined parts.
Sub SelectBoldandUnderlineCurrentParagraph()
'
' SelectBoldandUnderlineCurrentParagraph Macro
'
'
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.Find.ClearFormatting
With Selection.Find.Font
.Bold = True
.Underline = wdUnderlineSingle
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
Try:
Sub Demo()
With Selection.Paragraphs.First.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Text = ""
.Replacement.Text = ""
.Format = True
.Forward = True
.Wrap = wdFindStop
.Execute
End With
.Select
End With
End Sub
I want to replace every occurrence of the string "#PAGEBREAK# with an actual pagebreak. This is what I came up with:
Sub InsertPageBreak()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "#PAGEBREAK#"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.InsertBreak Type:=wdPageBreak
.Execute
End With
End With
Application.ScreenUpdating = True
End Sub
What actually happens: The string "#PAGEBREAK#" is exchanged for an empty string. The .Find works as intended but I get the error message:
Method or Object not found
on the
.InsertBreak Type:= wdPageBreak
What methods could be used here in which way?
This will work For you:
Sub InsertPageBreak()
ActiveDocument.Range.Select
With Selection.Find
.Text = "#PAGEBREAK#"
.Execute
End With
If Selection.Find.Found Then
Selection.GoTo What:=wdGoToBookmark, Name:="\Page"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.InsertBreak Type:=wdPageBreak
End If
End Sub
If you want to Replace all of the "#PAGEBREAK#", use this below code:
Sub InsertPageBreak()
ActiveDocument.Range.Select
Do
With Selection.Find
.Text = "#PAGEBREAK#"
.Execute
End With
If Selection.Find.Found Then
Selection.GoTo What:=wdGoToBookmark, Name:="\Page"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.InsertBreak Type:=wdPageBreak
Else: Exit Sub
End If
Loop
End Sub
How do I find a phrase, go to the beginning of the line the phrase is in, insert a page break, then execute the macro again.
I have attempted the following but it will not go to the following value of "Agent Name" upon subsequent execution.
Sub mFI()
' ' mFI Macro ' '
Selection.MoveRight Unit:=wdCharacter, Count:=1
With Selection
.Find
.ClearFormatting
.Forward = True
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Agent Name"
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertBreak Type:=wdPageBreak, Count:=1
End Sub
assuming code you provided is correct, This will help you.
Sub mFI()
' ' mFI Macro ' '
Selection.MoveRight Unit:=wdCharacter, Count:=1
With Selection
.Find
.ClearFormatting
.Forward = True
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Agent Name"
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertBreak Type:=wdPageBreak, Count:=1
With Selection
.Find
.ClearFormatting
.Forward = True
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="Agent Name"
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
End Sub
IF you want to insert page break to all the occurrences of agent name you could try.
Sub Demo()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Agent Name"
.Replacement.Text = "^m^&"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Hi Guys can someone help me because its really giving me a hard time i am new in creating macro so plz help me as simple as you can :)
I've created a macro for copying and pasting specific text in two different documents. I'm almost done with this. The process while running the macro is working fine but the problem is when i click the done message my ms word become not responding i really don't know why but sometimes it's working.
Can someone help me figuring out the problem or can someone reconstruct my codes for a better output thanks.
enter code here
Dim iCount As Long
iCount = 0
Dim MyAr() As String
Dim i As Integer
i = 0
Do
ContinueLoop:
iCount = iCount + 1
Selection.EndKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "checksum*>"""
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute = False Then
MSG = MsgBox("Done Checking")
Selection.Find.Text = ","
Selection.Find.Execute Replace:=wdReplaceAll
Exit Do
Else
End If
Selection.MoveRight unit:=wdCharacter, Count:=2
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*?.pdf"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
ReDim Preserve MyAr(i)
MyAr(i) = Selection
Windows(1).Activate
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = MyAr(0)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute = True Then
Selection.Find.ClearFormatting
With Selection.Find
.Text = "keying*>"""
.Replacement.Text = ""
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveRight unit:=wdCharacter, Count:=2
Windows(2).Activate
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.MoveDown unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Cut
Windows(1).Activate
Selection.TypeParagraph
Selection.PasteAndFormat (wdPasteDefault)
Windows(2).Activate
Else
Windows(2).Activate
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.MoveDown unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
Selection.HomeKey unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.Find.Text = "ck"
Selection.Find.Execute
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.TypeText Text:=","
GoTo ContinueLoop
End If
Loop While Selection.Find.Execute = False
I think you have an endless loop - change the last line to "Loop while selection.find.execute = true" so it will stop searching once the find = false.
I have recorded a simple macro to find the word "Quantity", go to the end of that line and insert a carriage return. I need to repeat it to the end of the document and quit, or else I'll have an infinite loop.
The code:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Quantity:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Change you code to this, note the use of wdFindStop.
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Quantity:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
do while Selection.Find.Execute = true
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
loop
If you have the type of documents this can fail on you can use the Selection.Start by
replacing the loop like this:
Dim lastPos As Long
lastPos = -1
Do While Selection.Find.Execute = True
If lastPos > Selection.Start Then Exit Do
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Loop
Add Selection.Find.Execute Replace:=wdReplaceAll after your End with