Tech Eval

[Greg]

I have been working on a macro to simplify cleaning up
text pasted from the web. In the process I found my code
had grown larger and larger due mainly to repetitive
steps. I stumbled on a feature called Case and managed to
apply it which greatly reduced the clutter in my code.
While it is working, I was wondering if someone would take
a peek and let me know if I have used Case in a method for
which is was intended. Thanks

Sub CleanUpText()

Dim EP As Paragraph
Dim TextChar As String
Dim i As Long

i = 1

If MsgBox("Do you want to remove leading spaces or _
characters?", vbYesNo) = vbYes Then

ActiveDocument.Range(0, 0).Select

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
For i = 1 To 14
Select Case i
Case 1
.Text = "< {1,}*"
.Replacement.Text = ""
Case 2
.Text = "(^13)( {1,}*)"
.Replacement.Text = "\1"
Case 3
.Text = "(^l)( {1,}*)"
.Replacement.Text = "\1"
Case 4
.Text = "( {1,})(^13)"
.Replacement.Text = "\2"
Case 5
.Text = "( {1,})(^l)"
.Replacement.Text = "\2"
Case 6
.Text = "([\>]{1,})( {1,})"
.Replacement.Text = ""
Case 7
.Text = "(^l)([\> ]{1,})"
.Replacement.Text = "\1"
Case 8
.Text = "(^13)([\> ]{1,})"
.Replacement.Text = "\1"
Case 9
.Text = "(^l)([\<]{1,})"
.Replacement.Text = "\1"
Case 10
.Text = "(^13)([\<]{1,})"
.Replacement.Text = "\1"
Case 11
.Text = "(^13)( {1,})"
.Replacement.Text = "\1"
Case 12
.Text = "(^l)( {1,})"
.Replacement.Text = "\1"
Case 13
Do
TextChar = InputBox("Type in any additional " & _
"leading character")
.MatchWildcards = False
.Text = TextChar
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
Loop While TextChar > ""
Case 14
.MatchWildcards = True
.Text = "< {1,}*"
.Replacement.Text = ""
Case Else
Exit For
End Select
.Execute Replace:=wdReplaceAll
Next
End With
End If

i = 1
If MsgBox("Do you want to replace linebreaks " & _
with paragraph fromatting?", vbYesNo) = vbYes Then
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
For i = 1 To 2
Select Case i
Case 1
.Text = "^l{2,}"
.Replacement.Text = "^p"
Case 2
.Text = "^l{1,}"
.Replacement.Text = " "
Case Else
Exit For
End Select
.Execute Replace:=wdReplaceAll
Next
End With
End If

If MsgBox("Do you want to delete empty paragraphs" & _
" in this document?", vbYesNo) = vbYes Then
For Each EP In ActiveDocument.Paragraphs
If Len(EP.Range.Text) = 1 Then EP.Range.Delete
Next EP
End If

End Sub

 

[Greg Maxey]

Pete,

Thanks. I am battening down the hatches right now in preparation for
Hurricane Frances. I will have a look at this when (or maybe if) I return.


--
Greg Maxey
A peer in "peer to peer" support
Rockledge, FL
To e-mail, edit out the "w...spam" in (e-mail address removed)

Greg,

Actually, it would probably be a great deal simpler for you to use a
function rather than repeated (and slow) case statements...

I'm paraphrasing your code here, but this is the idea...

This uses a function to hold the search/replace code and all you do
is pass arguments into it. You'll probably have to add more
parameters to the ReplaceSpecific function declaration so you can add
your wildcard flags etc, but that won't be too difficult for you.

Neater code. Easier to code, easier to read, easier to maintain.

Hope it helps...!!

Pete.

Sub ReplaceAll ()

Call ReplaceSpecific ( "< {1,}*", "") ' Your case 1
Call ReplaceSpecific ("(^13)( {1,}*)", "\1") ' Your case 2
Call ReplaceSpecific ("(^l)( {1,}*)","\1") ' Your case 3
Call ReplaceSpecific ("( {1,})(^13)", "\2") ' Your case 4

' etc....

End Sub

Function ReplaceSpecific (sSearchFor As String, sReplaceWith As
String)

ActiveDocument.Range(0, 0).Select

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Text = sSearchFor
.Replacement.Text = sReplaceWith
.Execute Replace:=wdReplaceAll
Next
End With

End Function

I have been working on a macro to simplify cleaning up
text pasted from the web. In the process I found my code
had grown larger and larger due mainly to repetitive
steps. I stumbled on a feature called Case and managed to
apply it which greatly reduced the clutter in my code.
While it is working, I was wondering if someone would take
a peek and let me know if I have used Case in a method for
which is was intended. Thanks

Sub CleanUpText()

Dim EP As Paragraph
Dim TextChar As String
Dim i As Long

i = 1

If MsgBox("Do you want to remove leading spaces or _
characters?", vbYesNo) = vbYes Then

ActiveDocument.Range(0, 0).Select

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
For i = 1 To 14
Select Case i
Case 1
.Text = "< {1,}*"
.Replacement.Text = ""
Case 2
.Text = "(^13)( {1,}*)"
.Replacement.Text = "\1"
Case 3
.Text = "(^l)( {1,}*)"
.Replacement.Text = "\1"
Case 4
.Text = "( {1,})(^13)"
.Replacement.Text = "\2"
Case 5
.Text = "( {1,})(^l)"
.Replacement.Text = "\2"
Case 6
.Text = "([\>]{1,})( {1,})"
.Replacement.Text = ""
Case 7
.Text = "(^l)([\> ]{1,})"
.Replacement.Text = "\1"
Case 8
.Text = "(^13)([\> ]{1,})"
.Replacement.Text = "\1"
Case 9
.Text = "(^l)([\<]{1,})"
.Replacement.Text = "\1"
Case 10
.Text = "(^13)([\<]{1,})"
.Replacement.Text = "\1"
Case 11
.Text = "(^13)( {1,})"
.Replacement.Text = "\1"
Case 12
.Text = "(^l)( {1,})"
.Replacement.Text = "\1"
Case 13
Do
TextChar = InputBox("Type in any additional " & _
"leading character")
.MatchWildcards = False
.Text = TextChar
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
Loop While TextChar > ""
Case 14
.MatchWildcards = True
.Text = "< {1,}*"
.Replacement.Text = ""
Case Else
Exit For
End Select
.Execute Replace:=wdReplaceAll
Next
End With
End If

i = 1
If MsgBox("Do you want to replace linebreaks " & _
with paragraph fromatting?", vbYesNo) = vbYes Then
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
For i = 1 To 2
Select Case i
Case 1
.Text = "^l{2,}"
.Replacement.Text = "^p"
Case 2
.Text = "^l{1,}"
.Replacement.Text = " "
Case Else
Exit For
End Select
.Execute Replace:=wdReplaceAll
Next
End With
End If

If MsgBox("Do you want to delete empty paragraphs" & _
" in this document?", vbYesNo) = vbYes Then
For Each EP In ActiveDocument.Paragraphs
If Len(EP.Range.Text) = 1 Then EP.Range.Delete
Next EP
End If

End Sub