Remove all letters in all words except first letter of each word

[uebels]

I have a document in which I need to remove the letters of every word
in the document except the first letter and I need to do it without the
remaining (first) letters moving (together).
Any help would be most appreciated.
Thanks,
Ron

 

[Graham Mayor]

The only way to do this is to format all the letters you want to lose as
white coloured, otherwise there is no practical way you can create the same
space the letters occupied. The letters are still there, you simply can't
see them. The following is one way to do that:

Sub LeaveFirstLetter()
Selection.HomeKey Unit:=wdStory
On Error Resume Next
ActiveDocument.Styles.Add Name:="lStyleBlack",
Type:=wdStyleTypeCharacter
ActiveDocument.Styles("lStyleBlack").BaseStyle = "Default Paragraph
Font"
With ActiveDocument.Styles("lStyleBlack").Font
.Name = ""
.Color = wdColorBlack
End With
On Error Resume Next
ActiveDocument.Styles.Add Name:="lStyleWhite",
Type:=wdStyleTypeCharacter
ActiveDocument.Styles("lStyleWhite").BaseStyle = "Default Paragraph
Font"
With ActiveDocument.Styles("lStyleWhite").Font
.Name = ""
.Color = wdColorWhite
End With
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("lStyleWhite")
With Selection.Find
.Text = "?"
.Replacement.Text = "^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("lStyleBlack")
With Selection.Find
.Text = "(<?)"
End With
Selection.Find.Execute replace:=wdReplaceAll
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Greg Maxey]

I have studied Graham's method yet. Here is another, two step process.
First I formatted all non-first letter characters as bold and then replaced
bold formatted characters with a space. You could use any format (e.g., red
letters, underline, etc,) if you are using bold in normal formatting.

Sub ScratchMacro()
Dim oWord As Word.Range
Dim oChr As Word.Range
Dim myRng As Word.Range
For Each oWord In ActiveDocument.Range.Words
For Each oChr In oWord.Characters
If Not oChr = oWord.Characters.First _
And Not oChr = " " Then
oChr.Font.Bold = True
End If
Next oChr
Next
Set myRng = ActiveDocument.Range
With myRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "*"
.Font.Bold = True
.MatchWildcards = True
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
End With
End Sub

 

[Greg Maxey]

I meant that I hadn't studied Graham's method yet.

I have now. It works fine. However, here is a one step method (I think
based on very limited testing):

Sub ScratchMacro2()
Dim oWord As Word.Range
Dim oChr As Word.Range
For Each oWord In ActiveDocument.Range.Words
For Each oChr In oWord.Characters
If Not oChr = oWord.Characters.First _
And Not oChr = " " Then
oChr = Replace(oChr, oChr, " ")
End If
Next oChr
Next
End Sub

 

[uebels]

Thank you so very much Graham! you too Greg

Ron

 

[Greg Maxey]

Ron,

I tested on a string of words where the first letter was never repeated in
any of the subsequent letters in the word. The code I posted earlier is
therefore flawed. Doug Robbins has schooled me a little. Try:

Sub ScratchMacro3()
'Best method
Dim oWord As Word.Range
For Each oWord In ActiveDocument.Range.Words
For i = 2 To oWord.Characters.Count
If Not oWord.Characters(i) = " " Then
oWord.Characters(i) = " "
End If
Next i
Next oWord
End Sub

 

[Michael Bednarek]

The only way to do this is to format all the letters you want to lose as
white coloured, otherwise there is no practical way you can create the same
space the letters occupied. The letters are still there, you simply can't
see them.

[snip]

This will not always have the desired effect. E.g.: I have always, and
partially for exactly the reason here discussed, my Windows Display
colour for "Window" set to 224,224,224 where those white letters will of
course be visible. There may even be users who have "Blue background,
white text" selected, where colouring the letters white has no visible
effect.