How to replace a string of characters with the count of the charac

I have what seemed at first to be a trivial task for a Word 2003 SP2 macro
(VB 6.3).

Given a body of text containing a range of characters (letters (upper and
lower case), digits, punctuation, spaces), all but the letters A-Z need to be
removed, then the resulting text needs to be sorted, and finally, the count
of each letter should replace each block of sorted letters.

So: “I wandered lonely as a cloud, that floats on high o’er vales and hills,
etc., etc., with a few 12345 thrown in for good measure!” becomes
penultimately:
“AAAAAAAAACCCDDDDDEEEEEEEEEEFFFGGHHHHHHIIIIILLLLLLLMNNNNNNOOOOOOOOORRRRRSSSSSTTTTTTTUUVWWWWY”
and then finally: 9 0 3 5 10 3 2 6 5 0 0 7 1 6 9 0 0 5 5 7 2 1 4 0 1 0. (The
zeros appear where a letter in the sequence is missing and so the count for
that letter is zero).

I did some searching around and found very useful information on the use of
Search/Replace with wildcards from Graham Mayor and Klaus Linke at
word.mvps.org (excellent job – thank you!. I’ve been using MS Word for
probably 15 years and I still find something to learn :))

My initial code worked OK – my approach was to first select the entire body
of text and render it upper case, then use Search/Replace with the FIND
wildcard sequence [!A-Z] and the REPLACE sequence null to reduce the text to
solely A-Z.

A subsequent Search/Replace on the text added a carriage return after every
character, the result was sorted, followed by another Search/Replace to
remove all the carriage returns. (There may be a quicker/simpler way but I’m
not aware of it.)

When it came to replacing each block of the same letter with its count, I
hit a snag. Try as I might, I cannot find a simple programmatic way to do
what I want.

I thought I had a solution when I tested a manual approach, using FIND with
Highlight checked (so the count is returned, but more importantly the block
of matching text is selected on exiting FIND, so that – I thought – I could
just replace the selection with the contents of Selection.Characters.Count
(and add a space as a separator).

Not so. What works manually doesn’t appear to work in a macro.

If I create a macro (even if I record one) that uses FIND to locate and
select all matching characters, upon completion only the first character in
the group is selected, whether I use Selection or Range.

I haven’t found a bug report that describes the FIND problem – yet – and
there are clearly more complex workarounds that I could devise, but I’d
prefer to keep the solution minimal and simple if I can. I’d be very grateful
for some guidance, even if it’s to say: “Use a workaround; FIND is bugged.”

Best,
Peter

Example code:
Sub M8()
'
' Macro M8 created 10/15/2007 by Peter GQ Brooks
'

' Sort the text. Simplest way is to begin by making everything upper case
(A-Z), then use
' Search/Replace to remove everything that is NOT in the range A-Z (use
wildcards and the
' expression [!A-Z] for the FIND and null for the REPLACE).
' Then replace every character with itself plus a carriage return, making
each character a
' line on its own, then sort, then delete all carriage returns (replace
every carriage return
' with a null).

' Select the entire document.
' Change case to upper.

Selection.WholeStory
Selection.Range.Case = wdUpperCase

' Ensure Find/Replace boxes have no prior formatting to impede process

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Dump everything that isn't in the range A to Z.

With Selection.Find
.Text = "[!A-Z]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' Now look for "any single character" and replace it with the same character
and a carriage return

With Selection.Find
.Text = "^?"
.Replacement.Text = "^&^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' Sort entire document by paragraphs

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"

' Remove all carriage returns after sorting.

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' Loop from A to Z and replace with count of character

For asciipointer = 65 To 90

Selection.Find.ClearFormatting
With Selection.Find
.Text = Chr(asciipointer)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

' Experimental section, trying various solutions:

' Set myRange = ActiveDocument.Content
' myRange.Find.Execute FindText:=Chr(asciipointer), Forward:=True
' Stop
' If myRange.Find.Found = True Then myRange.Text =
Selection.Characters.Count
' Stop

' Selection.Find.Execute
' 'Selection.Delete
' Stop
' MsgBox (Selection.Characters.Count)
' Selection.InsertBefore Selection.Characters.Count
' Stop
' 'Selection.Replace
Next asciipointer

End Sub

.

Relevant Pages

  • Remove Line Breaks.
    ... Carriage Return which the ASCII for that is Chr ... In general to see the ASCII code of any character in any ... >how would I write a simple macro for this? ...
    (microsoft.public.access.formscoding)
  • Re: Using VBA to split a document into sections
    ... character, ... I need to run a small macro to split a passage into sections each ... Ideally it would split the passage on the page with a couple of carriage ...
    (microsoft.public.word.vba.general)
  • Re: Searching for and Replacing Multiple items in a macro
    ... Dim oRng As Word.Range ... .MatchWholeWord = False ... some code that will strip a Word document of the invalid characters - and ... The following code successfully removes the "*" character from my ...
    (microsoft.public.word.vba.general)
  • Re: Defining Font Spacing
    ... Word seems to support no more than a single decimal place for character ... Microsoft Word MVP ... "Steffen Rieke" wrote in message ... .MatchWholeWord = False ...
    (microsoft.public.word.vba.general)
  • I give up...
    ... character is really a "(" or not. ... Dim CheckCar As Range ... .Format = False ... .MatchWholeWord = False ...
    (microsoft.public.word.vba.general)