Word A shorter Version

Question

Word A shorter Version

SteveD 625

Hello From Steve

Objective find for example 2:35 PM the second and then selection.MoveUp Unit:=wdLine, Count:=2

Can the below please be shortened

Sub Time_Spacing_Correction()

Dim rng As range

Set rng = ActiveDocument.Content

With rng.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = "[0-9]{1,}:[0-9]{1,} [A-Z]{1,}"

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = True

.MatchWholeWord = False

.MatchWildcards = True

End With

With rng.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = "[0-9]{1,}:[0-9]{1,} [A-Z]{1,}"

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = True

.MatchWholeWord = False

.MatchWildcards = True

End With

Do While rng.Find.Execute

 rng.Select

 

selection.MoveUp Unit:=wdLine, Count:=2

selection.Delete Unit:=wdCharacter, Count:=3

selection.MoveDown Unit:=wdLine, Count:=1

rng.Collapse wdCollapseEnd

Loop

End Sub

Charles Kenyon 171K Reputation points Volunteer Moderator

2026-03-11T03:46:36.11+00:00

Please consider re-writing/reformatting your question. https://learn.microsoft.com/en-us/answers/questions/5677122/(article)-how-to-ask-a-question-in-the-q-a-forums
SteveD 625 Reputation points

2026-03-11T03:51:16.5666667+00:00

Hello Charles

Simply put Just find the second occurrence of the time ie 2:35 PM

All the Best

Steve

1 answer

Your answer

Charles Kenyon 171K Reputation points Volunteer Moderator

2026-03-11T03:46:36.11+00:00

Please consider re-writing/reformatting your question. https://learn.microsoft.com/en-us/answers/questions/5677122/(article)-how-to-ask-a-question-in-the-q-a-forums
SteveD 625 Reputation points

2026-03-11T03:51:16.5666667+00:00

Hello Charles

Simply put Just find the second occurrence of the time ie 2:35 PM

All the Best

Steve

Answer 1

Yes. The duplicated Find setup can be removed and the code can be simplified while keeping the same behavior:

Sub Time_Spacing_Correction()

    Dim rng As Range
    Set rng = ActiveDocument.Content

    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[0-9]{1,}:[0-9]{1,} [A-Z]{1,}"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = True
    End With

    Do While rng.Find.Execute
        rng.Select
        Selection.MoveUp Unit:=wdLine, Count:=2
        Selection.Delete Unit:=wdCharacter, Count:=3
        Selection.MoveDown Unit:=wdLine, Count:=1
        rng.Collapse wdCollapseEnd
    Loop

End Sub

The Find configuration is defined once, then reused in the loop with rng.Find.Execute.

References: