Word Macro ro find duplicates only runs during recording

[sugarmaker]

Here is the goal: Using Word 2003, Find if a file has duplicate strings that match the regular expression: “CAD[0-9]@.[0-9]@>". The target string example is: CAD200709273579.86. The number of records will be 10-100 typically.

I recorded a macro to search the file, highlight then copy the hits, open a new doc, paste the selection then sort ascending text. With a quick visual inspection, dups are obvious. Not ideal but effective. And it works

Problem: it only works once. The macro will not execute after the recording. It bombs on
“Selection.Copy”. Also I’d really like a dialog box to pop and say. “xx number of Duplicate found” or “No Duplicates found”


Thanks help is appreciated

.

Sub Sample()
'
' Sample Macro
' Macro recorded 10/25/2007
'

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "CAD[0-9]@.[0-9]@>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Copy
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
:=wdEnglishUS, SubFieldNumber:="Paragraphs", SubFieldNumber2:= _
"Paragraphs", SubFieldNumber3:="Paragraphs"
End Sub

 

[fumei]

You say this works once? If I copy your code and try, it does not work even once. There is no .Execute instruction, so there IS no Selection. Therefore Selection.Copy fails.

True, if you actually record this, it does work while you are recording. This is a good example of how macro recording does not always translate correctly. The macro recording does not explicitly include the .Execute instruction.

It would be better to use a range. Like this:

Sub CopyNumber()
Dim ThisDoc As Document
Dim ThatDoc As Document
Dim r As Range
Set ThisDoc = ActiveDocument
Set r = ThisDoc.Range
Set ThatDoc = Documents.Add
With r.Find
   .ClearFormatting
   .MatchWildcards = True
   .Text = "CAD[0-9]@.[0-9]@>"
   Do While .Execute(Forward:=True) = True
      ThatDoc.Range.InsertAfter Text:=r.Text & vbCrLf
   Loop
End With
ThatDoc.Range.Select
    Selection.Sort ExcludeHeader:=False, _
        FieldNumber:="Paragraphs", _
        SortFieldType:=wdSortFieldAlphanumeric, _
        SortOrder:=wdSortOrderAscending, _
        FieldNumber2:="", _
        SortFieldType2:=wdSortFieldAlphanumeric, _
        SortOrder2:= wdSortOrderAscending, _
        FieldNumber3:="", _
        SortFieldType3:= wdSortFieldAlphanumeric, _
        SortOrder3:=wdSortOrderAscending, _
        Separator:= wdSortSeparateByTabs, _
        SortColumn:=False, CaseSensitive:=False, _
        LanguageID:=wdEnglishUS, _
        SubFieldNumber:="Paragraphs", _
        SubFieldNumber2:= "Paragraphs", _
        SubFieldNumber3:="Paragraphs"

End Sub

This will copy all found instances to a new document. It will also sort that new document.

As for the duplicate issue, there is no provision for detecting duplicates. It sorts only.

What exactly do you want? Do you want the duplicates copied over? Not copied over? Copied over but counted? It will take a bit more code to do that.

faq219-2884

Gerry
My paintings and sculpture

 

[sugarmaker]

Thanks. that worked great.

Clarification, the macro never worked only the recording of it worked as you suspected. I did try putting the execute in but it still crashed. Your range is a much better solution.

If dups are detected, then the business process that created this file needs to be rexecuted, rather than fixing this file by hand.