Find what box in Find and replace limits the length of a search term

Hoxton118 · #1 06-06-2014, 09:25 AM

This regex expression will find three consecutive words beginning with capital letters:

(<[A-Z][A-z0-9]{1,}>)( )(<[A-Z][A-z0-9]{1,}>)( )(<[A-Z][A-z0-9]{1,}>)

The "Find what" box in "Find and replace" is limited in terms of how long a regex can be. I would like to find six consecutive words beginning with capital letters, so the Find what box will not work for me.

Is there a VBA solution to make Word accept a longer "Find what" expression so that I can overcome this?

Many thanks.

macropod · #2 06-06-2014, 05:13 PM

The limitation relates to the complexity of wildcard expressions, not of the Find/Replace dialogue's capacity. Using a macro doesn't change that. That said, you could use a macro like:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, bFnd As Boolean
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][! ]@> <[! ]@> <[! ]@> <[! ]@> <[! ]@> <[! ]@>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    bFnd = True
    For i = 1 To UBound(Split(.Text, " "))
      If Not Left(Split(.Text, " ")(i), 1) Like "[A-Z]" Then
        bFnd = False
        .End = .Duplicate.Words(i).End
        Exit For
      End If
    Next
    If bFnd = True Then
      j = j + 1
      MsgBox .Text
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox j & " instances found."
End Sub

Basically, the macro looks for 5 space-separated words, the first of which begins with capitals. Having found them, it tests whether the remaining words all begin with capitals before continuing. As coded, you'll get a message box if a match is made.

gmaxey · #3 06-06-2014, 08:10 PM

Here is another variation. Not better just different:

Code:

Sub Demo()
Dim oRng As Word.Range
Dim i As Long, j As Long
Dim bFound As Boolean
  Application.ScreenUpdating = False
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "<[A-Z][! ]@>"
    .Wrap = wdFindStop
    .MatchWildcards = True
    While .Execute
      bFound = True
      oRng.MoveEnd wdWord, 6
      For i = 2 To oRng.Words.Count
        If Not oRng.Words(i).Characters(1) Like "[A-Z]" Then bFound = False
      Next
      If bFound = True Then
        j = j + 1
        MsgBox oRng.Text
      End If
      oRng.Collapse wdCollapseEnd
    Wend
  End With
  Application.ScreenUpdating = True
  MsgBox j & " instances found."
End Sub

Hoxton118 · #4 06-09-2014, 02:22 AM

Thanks both for these - very helpful. It is possible to amend the code so that the results are produced in a separate file, with a paragraph break between each. I'm hoping to produce a list of them.

Thanks.

macropod · #5 06-09-2014, 03:18 AM

I've already given you code for exporting the found expressions to another file, here: https://www.msofficeforums.com/word-...-multiple.html
It's simply a matter of adapting the code you've been given in this thread to do likewise.

Hoxton118 · #6 06-09-2014, 04:13 AM

Thanks, I've tried to splice the code but it doesn't work. Grateful for any help.

Code:

Sub Bar()
'
' Bar Macro
'
'
Application.ScreenUpdating = False
Dim i As Long, j As Long, bFnd As Boolean
With ActiveDocument.range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][! ]@> <[! ]@> <[! ]@> <[! ]@> <[! ]@> <[! ]@>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    bFnd = True
    For i = 1 To UBound(Split(.Text, " "))
      If Not Left(Split(.Text, " ")(i), 1) Like "[A-Z]" Then
        bFnd = False
        Exit For
        .End = .Duplicate.Words(i).End
      End If
        .Collapse wdCollapseEnd
    .Find.Execute
    Next
  Do While Selection.Find.Execute
Selection.StartOf Unit:=wdParagraph
Selection.MoveEnd Unit:=wdParagraph
sBigString = sBigString + Selection.Text
Selection.MoveStart Unit:=wdParagraph
Loop
Documents.Add DocumentType:=wdNewBlankDocument
Selection.InsertAfter (sBigString)
End Sub

macropod · #7 06-09-2014, 04:31 PM

I don't really see any indication of anything from the two macros I've given you being combined.

Try:

Code:

Sub BarDemo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, bFnd As Boolean
Dim SrcDoc As Document, RsltDoc As Document
Set SrcDoc = ActiveDocument
Set RsltDoc = Documents.Add
With SrcDoc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[A-Z][! ]@> <[! ]@> <[! ]@> <[! ]@> <[! ]@> <[! ]@>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    bFnd = True
    For i = 1 To UBound(Split(.Text, " "))
      If Not Left(Split(.Text, " ")(i), 1) Like "[A-Z]" Then
        bFnd = False
        .End = .Duplicate.Words(i).End
        Exit For
      End If
    Next
    If bFnd = True Then
      j = j + 1      
      RsltDoc.Range.InsertAfter vbCr
      RsltDoc.Characters.Last.FormattedText = .Duplicate.FormattedText
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox j & " instances found."
End Sub

Hoxton118 · #8 06-10-2014, 05:05 AM

Many thanks. This works very well.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find/Find and Replace Loop	Tango Mike	Word	3	04-20-2014 02:47 PM
Search and replace tabulators of different length...?	Flabbergaster	Word VBA	9	10-30-2012 05:40 AM
Bad view when using Find and Find & Replace - Word places found string on top line	paulkaye	Word	4	12-06-2011 11:05 PM
Is there a way to use "find/replace" to find italics words?	slayda	Word	3	09-14-2011 02:16 PM
can Find/Replace NOT find something?	Bobosmite	Word	6	05-27-2010 08:09 PM