views:

3457

answers:

2

Hello all!

Thanks in advance for your help!

I have a VBA macro for Microsoft Word that I am trying to improve.

The purpose of the macro is to bold and italicize all words in a document that match the search terms in the first table of the document.

The problem is the search terms include wildcards which are the following:

the hyphen "-": between letters a wildcard for either a space or a period

asterisk "&": (the site is not letting me put in asterisks as this is the markdown for italicize, so I'll put in the & symbol instead to get around the filters) a wildcard for any number of characters at the beginning of a word or at the end. Unlike normal programming languages though, when it is used in the middle of the word it needs to be combined with the hyphen to be a wildcard for a range of characters. For example "th&-e" would pick up "there" while "th&e" would not.

question mark "?": wildcard for a single character

What I am doing so far is just testing for these characters and if they are present I either lop them off in the case of the asterisk, or I alert the user that they have to search for the word manually. Not ideal :-P

I have tried the .MatchWildcard property in VBA but have not yet gotten it to work. I have a feeling it has something to do with the replacement text, not the search text.

A working macro will take the following as its input (the first row is intentionally ignored and the second column is the one with the target search terms):

Imagine this in a table all in the second column (as the html allowed here doesn't allow tr and td etc)

First row: Word
Second row: Search
Third row: &earch1
Fourth row: Search2&
Fifth row: S-earch3
Sixth row: S?arch4
Seventh row: S&-ch5

And it will search the document and replace with bold and italicized content like so:

Search Search1 Search2 Search3 Search4 Search5

Note: S-earch3 could also pick up S.earch3 and replace with Search3

As one might assume the search terms will usually not be right next to each other - the macro should find all instances.

I will include my attempted but nonfunctional code as well after the first working macro.

The code for the working macro will be on pastebin for a month from today, which is 9/17/09, at the following url:

http://pastebin.com/m7ee9165f

Thanks again for any thoughts and help you might have to offer!

Sara

Working VBA Macro:

Sub AllBold()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, rngLen, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start, End:=rngTable.End - 1

    End If

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = rngTable.Text

            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

If bolWild = True Then

MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)

End If

End Sub

Attempted Nonfunctional VBA Macro:

Sub AllBoldWildcard()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String

Dim strWildcard As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "&", vbTextCompare) > 0 Then 'remember to replace & with asterisk!'

    strWildcard = rngTable.Text

    rngTable.Text = Replace(rngTable.Text, "&", "", 1) 'remember to replace & with asterisk!'

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWildcard = Replace(rngTable.Text, "-", "[.-]", 1)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    strWildcard = Replace(rngTable.Text, "?", "_", 1)


    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = strWildcard

            .MatchAllWordForms = False

            .MatchSoundsLike = False

            .MatchFuzzy = False

            .MatchWildcards = True


            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

'    If bolWild = True Then'

'    MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)'

'    End If'

End Sub
A: 

Maybe the LIKE statement could help you:

if "My House" like "* House" then

end if

Regular Expressions: Searching for Search4 and replace it by SEARCH4 and using wildcards to achieve that:

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True 

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch([0-9]+)"


newText = objRegEx.Replace("Test Search4", "SEARCH$1")
MsgBox (newText) 
'gives you: Test SEARCH4

More information how those wildcards to use can be found here It might be hard in the beginning but I promise you will love it ;)

You can replace use to search for strings too:

Dim text As String text = "Hello Search4 search3 sAarch2 search0 search"

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch[0-9]+"


If (objRegEx.test(text) = True) Then
    Dim objMatch As Variant
    Set objMatch = objRegEx.Execute(text)   ' Execute search.

    Dim wordStart As Long
    Dim wordEnd As Long
    Dim intIndex As Integer
    For intIndex = 0 To objMatch.Count - 1
        wordStart = objMatch(intIndex).FirstIndex
        wordEnd = wordStart + Len(objMatch(intIndex))

        MsgBox ("found " & objMatch(intIndex) & " position: " & wordStart & " - " & wordEnd)
    Next
End If

The result for the variable text would be:

Search4 position: 6 - 13
Search3 position: 14- 21
...

So in your code you would use

rngTable.Text as text

and

rngTable.SetRange Start:=rngTable.Start + wordStart, End:=rngTable.Start + wordEnd

would be the range you want to set bold.

Ghommey
Thanks for posting! This sounds about right, but I'm trying to find an example of code to illustrate how "like" would be used in a search and replace. As luck would have it the word "like" is frequently used in the English language to mean things other than code, so I'm having trouble with the ever-so-picky search engines! ;-)Could you either post an example of code using the VBA Find or a link that points me to a tutorial illustrating it?Much obliged!
saranicole
How sweet are you?? Thanks for the code - I notice this is in vbscript - will that be compatible with VBA? I didn't think VBA supported regular expressions, just wildcards (else that's the first thing I would've gone with. Gotta love MS Office development :-P)
saranicole
You'r welcome. I tried that sample code using MS Word 2008 with out any problems. VBA is afaik VBScript plus the MS Office Api.
Ghommey
This helps a lot! Still kinda getting stuck on the bold formatting part. Since I'm using the Find method to add bold formatting to the Replacement text, I'm not sure how to use the Regex object instead but still return the formatted string.I could loop through every word in the document and test it against the Regex and then format it on success, but that seems like overkill. Plus I don't see that the Regex Replace method returns a boolean to test, only the success string. Match sounds like it might do better, but it apparently won't return positions of matches (per your tutorial :-) .
saranicole
Actually I may be on to something now - <http://dotnetslackers.com/Community/blogs/dsmyth/archive/2006/09/09/Regular-expressions-with-Word.aspx> looks VERY promising ... I'm testing my regex now ... (hopeful/excited)
saranicole
Mmmm, maybe not. I am very close, but not close enough. Can't get the regex to work right and I keep getting a "value out of range" error. No biggie if this can't be resolved, I'll just go with my original solution.
saranicole
I've narrowed down a problem with the bolding to the fact that the Match.FirstIndex changes if there is a table in the document. Now I'm trying to figure out how to account for the offset in a document that will have a variably-sized table!
saranicole
+1  A: 
Sub AllBold()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim intMatch As Integer

Dim celColl As Cells

Dim i As Integer

Dim strRegex As String

Dim Match, Matches


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    If rngTable.Text <> "" Then
        strRegex = rngTable.Text

        strRegex = Replace(strRegex, "*-", "[\w]{0,}[^\w]{0,1}[\w]{0,}", 1)

        strRegex = Replace(strRegex, "*", "\w+", 1)

        strRegex = Replace(strRegex, "-", "[^\w]{0,1}", 1)

        strRegex = Replace(strRegex, "?", ".", 1)

        objRegEx.Pattern = "\b" + strRegex + "\b"

        Dim oRng As Word.Range

        Set oRng = ActiveDocument.Range

        Set Matches = objRegEx.Execute(ActiveDocument.Range.Text)

        intMatch = Matches.Count

        If intMatch >= 1 Then

        rngTable.Bold = True

        For Each Match In Matches

            With oRng.Find

            .ClearFormatting

            .Text = Match.Value

            With .Replacement

            .Text = Match.Value

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

            End With

        Next Match

        End If

    End If
Next i

End Sub
saranicole
So in the end, it turned out I couldn't use the Match.FirstIndex, because the way the document was set up the tables threw that off. I ended up using the Word Find within the Matches For Each to find the Match.Value rather than using the Range. This is the exact solution I was looking for. @ghommey I couldn't have done it without you - between the two of us this solution worked out perfectly.
saranicole
nice to hear that I could help you
Ghommey