Just wanted to say people who can code are seriously next level,
I am unfortunately not one of those people.
I'v been set a task at work, which I assume there must be a quicker way to complete.
After research I came across this, but it only works for 15 words at a time, but I have around 500 words to find and replace, which I had been doing manually.
Any adaptations, if you dont mind, please dumb it down for me, all I know is how to paste to Visual Basic and run. I can input comma separated values/paths.
Sub FindAndReplaceMultiItems()
Dim strFindText As String
Dim strReplaceText As String
Dim nSplitItem As Long
Application.ScreenUpdating = False
' Enter items to be replaces and new ones.
strFindText = InputBox("Enter items to be found here,seperated by comma: ", "Items to be found")
strReplaceText = InputBox("Enter new items here, seperated by comma: ", "New items")
nSplitItem = UBound(Split(strFindText, ","))
' Find each item and replace it with new one respectively.
For nSplitItem = 0 To nSplitItem
With Selection
.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = Split(strFindText, ",")(nSplitItem)
.Replacement.Text = Split(strReplaceText, ",")(nSplitItem)
.Format = False
.MatchWholeWord = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End With
Next nSplitItem
Application.ScreenUpdating = True
End Sub
Any help would be very appreciated : )
Bonus Question: How to apply all these find and replacements to 900 documents?
Example data: (Controlled documents so I cant share real data unfortunately)
A dfe-tbh,scf-b9jt,dvf-hnk,pol-jbv,dn-fgm,gh-jkl
B df12-hbt,dvf-dgf,hj-gngk,dbs-ghdn,fbh-ghg,gfn-dhn
Related
Desired outcome is when the user presses their shortcut, the cursor jumps to the next instance of multiple search terms. For now let's say "[Ff]izz" and "[Bb]uzz". I don't want to make any changes, just jump forward through the doc to the next instance.
Current code is as follows, but what it's doing is jumping to the next instance of "fizz" if Wrap is set to wdFindStop, or "buzz" if Wrap is set to wdFindContinue or wdFindAsk. If a line was just "Fizz buzz buzz fizz", I'd like it to be able to select each individual word in order from left to right.
Sub FizzBuzzFinder()
Dim StrFind As String
Dim i As Long
StrFind = "[Ff]izz,[Bb]uzz"
Selection.Find.ClearFormatting
With Selection.Find
.MatchWildcards = True
.Wrap = wdFindAsk
.Forward = True
For i = 0 To UBound(Split(StrFind, ","))
.Text = Split(StrFind, ",")(i)
.Execute
Next i
End With
End Sub
Any idea what I'm doing wrong? Cheers in advance
The issue was your For Loop. It searches for Fizz, selects it, then searches for Buzz, advancing though the text. Since this happens together, the user only sees it select Buzz.
To correct this, I removed the For loop and changed the search string from two items to one item that matches either Fizz or Buzz.
Sub FizzBuzzFinder()
Dim StrFind As String
Dim i As Long
StrFind = "[FfBb][ui]zz"
Selection.Find.ClearFormatting
With Selection.Find
.MatchWildcards = True
.Wrap = wdFindAsk
.Forward = True
.Text = StrFind
.Execute
End With
End Sub
Unfortunately, this also matches Fuzz and Bizz.
I am trying to make my macro bring up a search box that allows me to enter as many words as I want, separated by comma, and then find each word in the list in the document and make them bold and blue. What I have right now actually DOES exactly what I want it to do. It finds each word that I enter into the searchbox (separated by commas), finds the word, and changes it to bold blue font.
The problem is this: I need to be able to enter a page or more of words. InputBox only gives me 255 characters to use at a time. Is there a modification to make to my code to be able to have no limit to the number of words I can paste in to change?
It doesn't help that I am new at this. It has taken me a day and a half to get where I am right now.
Sub BlueWords()
Dim blueword As String
Dim numberofwords As Long
Application.ScreenUpdating = False
' Enter words that need to become bold blue words.
blueword = InputBox("Enter items to be found here,seperated by comma: ", "Items to be found")
numberofwords = UBound(Split(blueword, ","))
' Find each item and replace it with new one respectively.
For numberofwords = 0 To numberofwords
With Selection
.HomeKey Unit:=wdStory
With Selection.Find
.Text = Split(blueword, ",")(numberofwords)
.Replacement.Text = ""
.Replacement.Font.Bold = True
.Replacement.Font.ColorIndex = wdBlue
.Format = True
.MatchWholeWord = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End With
Next numberofwords
Application.ScreenUpdating = True
End Sub
It works. I just need to be able to input more than 255 characters of words at a time. I need "no limit".
Add a user form instead, then add a button and a text box (there is no limit on text boxes in forms) then set the button to run the macro taking the input from the forms text box
Sub BlueWords()
Dim blueword As String
Dim numberofwords As Long
Application.ScreenUpdating = False
' Enter words that need to become bold blue words.
UserForm1.Show
'blueword = The super long input string in the userform
blueword = UserForm1.TextBox1.Text
numberofwords = UBound(Split(blueword, ","))
' Find each item and replace it with new one respectively.
For numberofwords = 0 To numberofwords
With Selection
.HomeKey Unit:=wdStory
With Selection.Find
.Text = Split(blueword, ",")(numberofwords)
.Replacement.Text = ""
.Replacement.Font.Bold = True
.Replacement.Font.ColorIndex = wdBlue
.Format = True
.MatchWholeWord = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End With
Next numberofwords
Application.ScreenUpdating = True
Unload UserForm1
End Sub
I am working with Word Docs containing quite a lot of pages and formulas.
I have an array containing expressions
dim YellowWord(1 to 100) as string
I want to start at the beginning of the word text to look for every of those words and have a look the instances where that word or expression is followed by a number or numbers into brackets
EXMAPLE:
yellowword(2)="the blue table"
using wildcards I can find: the blue table (34, 23) in the text.
what I want is filling another array that would be:
yellowwood_reference(2) = "(34, 23)"
the code I have is so:
for i=1 to NRofYellowWords
with active document.content.find
.clearformating
.text = yellowWord(i) & " " & "\((*)\)"
with .replacement
.clearformating
.text = yellowWord(i) & "(\1)"
'HERE IS WHERE I WANT TO SAY TO WORD:
'PUT THAT PART "(\1)" INTO A VARIABLE YELLOWWORD_REFERENCE(i)
'HOWW??????
.font.color = wdcolorred
'here i changed the color of the string with the references into red.
end with
.fordward = true
.wrap = wdfindcontinue
.format = true
.matchcase = false
.matchewholeword = false
.matchwildcards = true
.matchsoundslike = false
.matchallwordforms= false
.execute replace:=wdreplaceall
end with
next i
In the above code there are several problems:
the first one I wrote it in capital letters, getting that reference of the wild card into a variable.
The second one is that there might be many appearances of the YellowWord(2) in the text, I only need/want the first reference, not the rest. That means that the first time the code finds the blue table (24,26) after passing the value "(24, 26)" into another array the code should move on and not look for more instances of the blue table in the text.
btw, i used wildcards because there might be the case that the references are simple not into brackets, so i would have to run everything twice with a different wildcard.
By the way as you can imagine, once I get the array yellowWord_reference(i) I would add the references there where there are instances of YellowWord without refferences.
I would really appreciate help since I really clicked many websites with little success.
thanks a lot
cheers
PS: If you think that there is a better way to do all that without using .find just mention it please, i am quite new in Ms-Word and coming from VBA Excel i get headaches figuring out where is the selection point.
I modified your code so that if it finds your 'words', it will capture the numbers that follow.
The code you posted would never work due to the number of compile errors ... strongly suggest you start using "Option Explicit" and posting actual code rather than typing in in yourself.
Other notes:
The numbers are enclosed in parenthesis () - not brackets []
You were using a 'ReplaceAll'; if you only wanted the first occurance, change from '...All'
I removed the 'red font' and 'Replace' ... add it back if needed.
Your code would remove the space between the word and the number - is that what you wanted?
Here's the code:
Option Explicit
Sub Find_Words()
Dim yellowWord(100) As String
Dim yellowwood_reference(100) As String
Dim NRofYellowWords As Integer
Dim i As Integer
Dim lS As Long
Dim lE As Long
Dim sFound As String
Dim rng As Range
yellowWord(1) = "blue table"
yellowWord(2) = "little"
yellowWord(3) = "big"
yellowWord(4) = "xxx last xxx"
NRofYellowWords = 4
Set rng = ActiveDocument.Range
For i = 1 To NRofYellowWords
With rng.Find
.Text = yellowWord(i) & " " & "\((*)\)"
With .Replacement
.Text = yellowWord(i) & "(\1)"
End With
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found Then
' Find (numbers) & save
lS = InStr(rng.Start, ActiveDocument.Range.Text, "(")
If lS > 0 Then
lE = InStr(lS, ActiveDocument.Range.Text, ")")
sFound = Mid(ActiveDocument.Range.Text, lS, lE - lS + 1)
yellowwood_reference(i) = sFound
Debug.Print "Found: " & yellowWord(i) & vbTab & sFound
Else
MsgBox "Bad format; missing '('" & vbTab & Mid(ActiveDocument.Range.Text, lS, 50)
End If
Else
Debug.Print "Not Found: " & yellowWord(i)
End If
End With
Next i
Debug.Print "Finished"
End Sub
I am attempting to write a macro which will find text based on a checklist (you will see it in the code named checklist) in the current active document. I have pasted snippets of code together to make the macro found below. My problem lies in counting. I am trying to find out how many times the macro highlights something. Later this count will be used in conjunction with categories to count the amount of highlighted objects in a certain category (hopefully!). I have to admit, I can only vaguely follow what this code is actually doing as I am new to VBA. Any help would be much appreciated. All of my attempts to get an accurate count have failed.
To add to this, does anyone know of a method of counting for multiple lists? Say, I have a few words Apple and orange which belong to the fruit list and celery and broccoli which belong to the vege list. Each time Apple (or orange) is used it adds one to the count for fruit. The same goes for vegetables. I then want to have this data exported to an excel sheet. I know it sounds complicated. I am sorry. Thanks again for any help.
Sub CompareWordList()
'This macro will find all of the words or phrases in the checklist document (to be developed) and highlight them.
'Further to this, the macro will provide a word count which is to be added to certain assessment criteria
'which will be provided by ___ once the development of this macro is complete.
Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim wrdRef As Object
Dim count As Integer
sCheckDoc = "C:\Users\Nathaniel\Documents\checklist.docx"
Set docCurrent = Selection.Document
Set docRef = Documents.Open(sCheckDoc)
Set Range = ActiveDocument.Range
Application.ScreenUpdating = False
docCurrent.Activate
Options.DefaultHighlightColorIndex = wdYellow
count = 0
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
'.Replacement.Font.Bold = True
.Replacement.Highlight = True
.Replacement.Text = "^&"
.Forward = True
.Format = True
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
' I TRIED HERE* count = count +1
End With
For Each wrdRef In docRef.Words
If Asc(Left(wrdRef, 1)) > 32 Then
With Selection.Find
.Wrap = wdFindContinue
.Text = wrdRef
.MatchCase = False
.Execute Replace:=wdReplaceAll
End With
End If
'and here *count = count + 1
Next wrdRef
count = count + 1
If count <> 0 Then
MsgBox _
count & " item(s) highlighted "
Else
MsgBox "Nothing was not found in the document/selection matching the checklist"
End If
docRef.Close
docCurrent.Activate
Application.ScreenUpdating = True
End Sub
You can determine the number of possible replacements using RegEx. Assign the entire content of your document to a string, and then count the number of RegEx matches. Something like this would work
Sub CountReplacements() ' Make sure you add a reference to Microsoft VBScript Regular Expressions 5.5
Dim rex As New RegExp
rex.Pattern = "[0-9]" ' Change RegEx pattern to whatever works for you
rex.Global = True
Dim str As String: str = ActiveDocument.Content
Debug.Print Rex.Execute(str).Count
End Sub
I have 2 headers or markers that are a part of my RTF document. In my example I am showing a sentence when in reality it will be multiple sentences or paragraphs. I have used brackets instead of less than and greater than signs as they disappear in my question. All I want to do is replace the text between the 2 markers with the following sentence, "text goes here", without quotation marks.
[EmbeddedReport]Lots of text, thousands of character, multiple paragraphs[/EmbeddedReport]
I want replace all the text between the 2 markers replaced with "text goes here".
It would end up looking like this...
"[EmbeddedReport]text goes here[/EmbeddedReport]"
I've literally spent 2 days trying to solve this. Any help would be appreciated.
This is the last thing I tried...
Sub RemoveReport()
Dim c As Range
Dim StartWord As String, EndWord As String
Selection.HomeKey Unit:=wdStory
StartWord = "<ImageTable>"
EndWord = "</ImageTable>"
Set c = ActiveDocument.Content
c.Find.ClearFormatting
c.Find.Replacement.ClearFormatting
With c.Find
.Text = StartWord & "*" & EndWord
' MsgBox (.Text)
.Replacement.Text = "<ImageTable>text goes here</ImageTable>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
c.Find.Execute
While c.Find.Found
Debug.Print c.Text
'~~> I am assuming that the start word and the end word will only
'~~> be in the start and end respectively and not in the middle
Debug.Print Replace(Replace(c.Text, StartWord, ""), EndWord, "")
c.Find.Execute
Wend
End Sub
Word VBA is not my area of expertise, but it seems similar to a question I answered a few days ago.
Turns out the wildcard match was not doing what I hoped it would do, or at least it was not reliable. Also, I ran in to some trouble using angle brackets, so this uses square brackets. I suspect that word treats the angle brackets as markup/syntax, and thus does not interpret them as text in the Find object. There is probably a way around this, but Word VBA is not my specialty. There is also probably a more elegant solution, but again, Word VBA is not my specialty :)
Try something like this:
Option Explicit
Sub Test()
Dim doc As Document
Dim txtRange As Range
Dim startTag As String
Dim endTag As String
Dim s As Long
Dim e As Long
startTag = "[EmbeddedReport]"
endTag = "[/EmbeddedReport]"
Set doc = ActiveDocument
Set txtRange = doc.Content
'Find the opening tag
With txtRange.Find
.Text = startTag
.Forward = True
.Execute
If .Found Then
s = txtRange.Start
Else
GoTo EarlyExit
End If
End With
'Find the closing tag
Set txtRange = doc.Range(txtRange.End, doc.Content.End)
With txtRange.Find
.Text = endTag
.Forward = True
.Execute
If .Found Then
e = txtRange.End
Else
GoTo EarlyExit
End If
End With
Set txtRange = doc.Range(s, e)
txtRange.Text = startTag & "text goes here" & endTag
Exit Sub
EarlyExit:
MsgBox "Header not found in this document!", vbInformation
End Sub
It takes some time to figure it out at first, but learning to navigate the object model reference documentation for VBA will make these tasks a lot easier to figure out in the future.