3
\$\begingroup\$

I have a large amount of data from a hardware device that needs to be cleaned up so it can be analyzed in Excel.

I wrote a simple find/replace VBA macro in word to convert it to .csv, but the macro takes a long time to run through large sets of data.

I'm looking for suggestions on a faster way to code this. Alternately, if there is another option for cleaning the data that would work better than Word and VBA, I'm willing to switch to it.

Sub CleanText()


Application.ScreenUpdating = False

' clean data for import to excel
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "^p" & "^p"
    .Replacement.Text = "wvw"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "^p"
    .Replacement.Text = ","

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "wvw"
    .Replacement.Text = "^p"
    .Forward = True

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "$GPGGA" & "(*)" & "$GPRMC"
    .Replacement.Text = "$GPRMC"
    .MatchWildcards = True

End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "W" & "(*)" & "S"
    .Replacement.Text = "W,"
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "V" & "(*)" & "S"
    .Replacement.Text = "V,,,,,"
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "$GPRMC,"
    .Replacement.Text = ""
End With
Selection.Find.Execute Replace:=wdReplaceAll

Application.ScreenUpdating = True

End Sub
\$\endgroup\$
1
\$\begingroup\$

You're doing a lot with .Selection. By default, that is going to be slow. Doing things behind the scenes is always faster. Either way, working with selection isn't the best way to go. Either pass the document to the sub or prompt the user. Is the selection a document, text, body, header, title, section? Be explicit.

The way you use .Find makes me thing you're referring to a range, which can be any of those things. Let's take a look at the basic skeleton of your sub -

    With Selection
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find
    .Find.Execute
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find
    .Find.Execute
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find
    .Find.Execute
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find
    .Find.Execute
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find
    .Find.Execute
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find
    .Find.Execute
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find
    .Find.Execute
End With

Yikes. You're doing the same thing 7 times. At worst that should be refactored. Something like this -

Private Sub AlterRange(ByVal target As Range, ByVal findString As String, ByVal replaceString As String)
    With target
        .Find.ClearFormatting
        .Find.Replacement.ClearFormatting
        .Find
            .Text findString
            .Replacement replaceString
        .Find.Execute Replace:=wdReplaceAll
    End With
End Sub

Now something like this would work

Dim target As Range
Set target = Selection
Dim findStrings(1 To 7) As String
findStrings(1) = "^p^p"
findStrings(2) = "^p"
findStrings(3) = "wvw"
findStrings(4) = "$GPGGA" & "(*)" & "$GPRMC"
'...
Dim replacestrings(1 To 7) As String
replacestrings(1) = "wvw"
replacestrings(2) = ","
'...

Dim i As Long
For i = 1 To 7
    AlterRange target, findStrings(i), replacestrings(i)
Next

All of this is untested, but you get the idea.


What you could do to speed it up is to create a variant (or whatever) to store the entire selection in and then do your finding and replacing in the variant, then place the variant back out to the sheet overwriting the selection.

I don't know how all this would interact with your formatting, but it doesn't seem like you're keeping any formatting so it shouldn't be a problem.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.