Hi i have the codes below that is already working perfectly. What i can't figure out is how to count the number of times a wildcard search finds a match. Can anyone tell me how i can go about this? The codes are as follows:
Sub findfunction()
If (findHL(activedocument.Content, "[aeiou]")) = True Then MsgBox "Highlight vowels Done", vbInformation + vbOKOnly, "Vowels Highlight Result"
If (findHL(activedocument.Range, "<wa*>")) = True Then MsgBox "Highlight words beginning with WA", vbInformation + vbOKOnly, "Prefix Find Result"
End Sub
Function findHL(r As Range, s As String) As Boolean
Options.DefaultHighlightColorIndex = wdRed
r.Find.Replacement.highlight = True
r.Find.Execute FindText:=s, MatchWildcards:=True, Wrap:=wdFindContinue, Format:=True, replace:=wdReplaceAll
findHL = True
End Function
Any help would greatly be appreciated. Thanks guys!
I think you just need a static Counter field defined at the top of your module - i.e. not within any sub or function (which is what makes it static):
dim MatchCounter as long
Just initialize to zero at the appropriate place and have your matching function increment on each match. (Could also wrap this in a small Class if the initialization logic / update logic is spread around & hard to pin down).
Related
Would appreciate some help with this problem.
I need to find all occurrences of a string in a Word document. When the string is found some complicated editing is performed on it. Sometimes no editing is needed and the string is left untouched. When all that is taken care of, I continue looking for the next occurrence of the string. Until the end of the document.
I wrote a routine to do that :
It starts by defining a Range (myRange) that covers the whole document.
Then a Find.Execute is performed.
When an occurrence is found I do the editing work.
Meanwhile myRange has been automatically redefined to cover only the found region (this is well documented in the VBA WORD documentation > FIND Object).
Then I redefine myRange to cover the portion of the text from the end of the previous found region down to the end of the text.
I iterate this until the end of the document.
This routine works well EXCEPT when an occurrence of the string is found in a TABLE. Then it is impossible to redefine myRange to cover the region from the end of the previous found down to the end of the text. In the redefinition VBA insists on including the previous found region (actually the whole TABLE). So when I iterate it keeps finding the same occurrence again and again and looping for ever.
What follows is a simplified version of my routine. It does nothing it is just to illustrate the problem. If you run it on a document where the string "abc" appears you will see it running happily to completion. But if your document has an occurrence of "abc" in a TABLE the routine loops for ever.
Sub moreTests()
Dim myRange As Range
Dim lastCharPos As Integer
Set myRange = ActiveDocument.Range
lastCharPos = myRange.End
myRange.Find.ClearFormatting
With myRange.Find
.Text = "abc"
End With
While myRange.Find.Execute = True
'An occurrence of "abc" has been found
MsgBox (myRange.Text)
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
'myRange has been redefined to encompass only the found region (the "abc" string)
'Perform whatever editing work is needed on the string myRange.Text ("abc")
'Now redefine myRange to cover the remainder of the document
myRange.Start = myRange.End
myRange.End = lastCharPos
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
Wend
End Sub 'moreTests
I have several ways in mind to circumvent this problem. But none of them is simple, let alone 'elegant'. Does someone know if there is a 'standard' / 'proven' way of avoiding this problem ?
Many many thanks in advance.
I'm a beginner at coding, so please bear with me. Is there any way to use the function If to insert text (using TypeText), and then change the font of that text added using VBA Word?
So I'll give you some information on what I am working on; I am using the following code to count the number of spelling mistakes in a document.
Sub countErrors()
MsgBox (ActiveDocument.SpellingErrors.count)
End Sub
What I would like to do is use an If function to the number of spelling mistakes present. If there are any spelling mistakes I want to insert text at the top of the document saying "REJECTED " with font in red, bold and size 14. Is there any way to do this using the If function?
I tried adding the following to the above code;
Sub countErrors()
Msgbox (ActiveDocument.SpellingErrors.count)
If SpellingErrors <= 1 then
Selection.HomeKey unit:=wdStory
With Selection
.Font.Size = 14
.Font.ColorIndex = wdRed
.Font.Bold = True
End With
Selection.TypeText ("REJECTED ")
End If
End Sub
The code just counts the number of spelling mistakes and displays a MsgBox with it, and then that's where the code ends -- it doesn't add any text, etc.
Can someone please let me know where I am going wrong? This is extremely frustrating.
Thank you in advance.
Your code needs to check if SpellingErrors is greater than zero.
Sub CountErrors()
MsgBox "The document currently has " & ActiveDocument.SpellingErrors.Count & " spelling error(s)."
If ActiveDocument.SpellingErrors.Count > 0 Then
Selection.HomeKey unit:=wdStory
With Selection
.Font.Size = 14
.Font.ColorIndex = wdRed
.Font.Bold = True
.TypeText "REJECTED"
End With
End If
End Sub
How can I test whether the insertion point is at the start of a new page created by a manual page break? It seems like it should be as simple as checking if the preceding character is CHR(12), but that doesn't seem to work.
If Selection.Type = CHR(12) Then
Selection.TypeText Text:="HARD PAGE"
Else
Selection.TypeText Text:="NO HARD PAGE"
End If
Is it just a syntax error or do I have the wrong approach here?
You have to move the selection (or the range) backwards. Selection.Text (or Range.Text) always returns the character following the IP. Of course, you may not want to actually move the selection. That means you can work with a Range object to do the testing.
Since you have to move backwards, anyway, to test whether there's a hard pagebreak, I've put it in a loop so that the selection can be anywhere on the page, to begin with.
Also, I've added a check whether the macro has started on the first page, since you'd otherwise go into an infinite loop, moving backwards from the Selection to the next page.
Sub CheckWhetherHardPageBreak()
Dim rngToCheck As word.Range
Dim pgNr As Long
Dim pgNrChange As Long
Set rngToCheck = Selection.Range
pgNr = rngToCheck.Information(wdActiveEndPageNumber)
If pgNr = 1 Then
MsgBox "Can't start on Page 1"
Exit Sub
End If
pgNrChange = pgNr
Do While pgNrChange = pgNr
rngToCheck.MoveEnd wdCharacter, -1
pgNrChange = rngToCheck.Information(wdActiveEndPageNumber)
Loop
'Extend the selection to include the following character
'So that ASC() works
rngToCheck.MoveEnd wdCharacter, 1
If Asc(rngToCheck.Text) <> 12 Then
'Move it back before the previous character
'as the character immediately following a hard page break is Chr(13)
rngToCheck.MoveEnd wdCharacter, -2
End If
rngToCheck.MoveEnd wdCharacter, 1
If Asc(rngToCheck) = 12 Then
Selection.TypeText Text:="HARD PAGE"
Else
Selection.TypeText Text:="NO HARD PAGE"
End If
End Sub
I think you might be intending to use Chr(13) or Chr(10).
More information here:
Stack Overflow: What are carriage return, linefeed, and form feed?
I think I need to try and make this question easier. So here goes;
I am creating a User form in Excel that will act as a data capture form.
In this form I have a Textbox called PolBX In this a is placed and at submission data in PolBX is copied into the "G" column using this code
Cells(emptyRow, 7).Value = PolBX.Value. This works great.
I discovered that there may be instances where the User may accidently use the same Unique Id number twice. so I am trying to find out how to code it that after the User has entered the Unique Id number it would check for that string (Consists of letters and numbers). if it finds the string already in the 7th column(G) it must say something like
"Policy number already Used, please try again"
I am thinking I will need to use the following subroutine
Private Sub PolBX_AfterUpdate()
End Sub
Can some please assist with creating this code...
Also can you please explain what you are doing as I started VBA about a week ago
You can add the following code to search for your policy number, and if nothing found then PolLookup = Nothing.
Option Explicit
Sub Test()
On Error GoTo ErrHandler
Dim ws As Worksheet, PolLookup As Range, LookupRng As Range
Set ws = ThisWorkbook.Worksheets(1)
'This is the range you want to search, it can be a long range
'or it can be a single cell.
Set LookupRng = ws.Range("A:A")
'Range.Find is looking for your value in the range you specified above
Set PolLookup = LookupRng.Find("YourLookupValue")
'PolLookup = Nothing if it didn't find a match, so we want to use
'If <NOT> Nothing, because this suggests .Find found your value
If Not PolLookup Is Nothing Then
Err.Raise vbObjectError + 0 'Whatever error you want to throw for finding a match
End If
'Exit before you reach the ErrHandler
Exit Sub
ErrHandler:
If Err.Number = vbObjectError + 0 Then
'Handle your error. Do you want to stop completely? Or have the
'User enter a new value?
End If
End Sub
Basically, after your user enters their value in your UserForm, just make a call to this Sub to do a quick lookup.
Playing around I discovered a Much easier way! I included a Button with he following code attached
Private Sub CommandButton8_Click()
Search = PolBX.Text
Set FoundCell = Worksheets("sheet1").Columns(7).Find(Search,LookIn:=xlValues, lookat:=xlWhole)
If FoundCell Is Nothing Then
MsgBox "No duplicates found"
Else
MsgBox "This policy has already been Assessed" & "Please assess a different case"
PolBX.Value = ""
End If
I am attempting to create a macro in Word that alters the style of a set of ~150 unique headings. All styles must be identical. My current code works and changes the formatting correctly, but only one heading at a time.
Simply put, it's ugly.
I'm looking for something I can reuse, and possibly apply to more projects in the future.
Maybe using the loop command? I don't know, I'm still somewhat new using VBA.
Sub QOS_Headings()
Dim objDoc As Document
Dim head1 As Style, head2 As Style, head3 As Style, head4 As Style
Set objDoc = ActiveDocument
Set head1 = ActiveDocument.Styles("Heading 1")
Set head2 = ActiveDocument.Styles("Heading 2")
With objDoc.Content.Find
.ClearFormatting
.Text = "Section A.^p"
With .Replacement
.ClearFormatting
.Style = head1
End With
.Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
End With
End Sub
If there is no way in which you can identify the heads you want automatically you may have to write everything once. Create a separate function for this purpose. It might look like this:-
Private Function SearchCriteria() As String()
Dim Fun(6) As String ' Fun = Designated Function return value
' The number of elements in the Dim statement must be equal to
' the number of elements actually declared:
' observe that the actual number of elements is one greater
' than the index because the latter starts at 0
Fun(0) = "Text 1"
Fun(1) = "Text 2"
Fun(2) = "Text 3"
Fun(3) = "Text 4"
Fun(4) = "Text 5"
Fun(5) = "Text 6"
Fun(6) = "Text 7"
SearchCriteria = Fun
End Function
You can add as many elements as you wish. In theory it is enough if they are unique within the document. I shall add some practical concerns below. Use the code below to test the above function.
Private Sub TestSearchCriteria()
Dim Crits() As String
Dim i As Long
Crits = SearchCriteria
For i = 0 To UBound(Crits)
' prints to the Immediate Window:
' select from View tab or press Ctl+G
Debug.Print Crits(i)
Next i
End Sub
Now you are ready to try to actually work on your document. Here is the code. It will not effect any changes. It's just the infrastructure for testing and getting ready.
Sub ChangeTextFormat()
Dim Crits() As String
Dim Rng As Range
Dim Fnd As Boolean
Dim i As Long
Crits = SearchCriteria
For i = 0 To UBound(Crits)
' find the Text in the document
Set Rng = ActiveDocument.Content
With Rng.Find
.ClearFormatting
.Execute FindText:=Crits(i), Forward:=True, _
Format:=False, Wrap:=wdFindStop
Fnd = .Found
End With
If Fnd = True Then
With Rng
Debug.Print .Text
' .MoveStart wdWord, -2
' With .Font
' .Italic = True
' .Bold = True
' End With
End With
Else
Debug.Print "Didn't find " & Crits(i)
End If
Next i
End Sub
The first half of the procedure will find each of the search criteria in your document using the same kind of loop as you already know from the test procedure. But now the text is fed to the Find method which assigns the found text to the Rng range. If the item is found you now have a handle on it by the name of Rng.
The second half of the sub deals with the outcome of the search. If the text was found the found text (that is Rng.Text) is printed to the Immediate window, otherwise the original text Crits(i) with "didn't find".
If the text was found you want to assign a style to it. But before you can do so you should deal with the difference between the text you found and the text you want to format. This difference could be physical, like you didn't write the entire length of the text in the criteria, or technical, like excluding paragraph marks. In my above sub there is just random code (extending the Rng by two preceding words and formatting everything as bold italics). Consider this code a placeholder.
For your purposes code like this might do the job, perhaps. .Paragraphs(1).Style = Head1 Actually, that is rather a different question, and I urge you not to rush for this result too fast. The part you now have needs thorough testing first.