Formatting dates only in Diary transcriptions

[RobinClay]

I am SO lucky to have a team transcribing - a month at a time - my grandmother's diaries, 1900-1977.


I send out the scans and a "blank" Word Doc with the dates formatted, so I can then just paste that month into a file for that year.
But my most prolific transcriber always sends it back as a plain .txt file.
So I format say
"Sun Jan 1 1965 Salisbury"
as Bold, size 14

Then I click on the "Format Painter" icon,
then move to
"Mon Jan 2 1967 Home"
and select that entire line.
Job done !

BUT . . I have to do that 365 (or more !) times for each year !

Would some kind soul please give me a VBA routine that would

Run through the entire file
Find every line that is empty, but is followed by a line that starts with "Mon ", "Tue ", etc
Then format that entire second line as Bold, size 14.

I can do that SORT of thing in Excel VNA, no sweat - but WORD VBA is a complete mystery !

Pretty please ?

[vivka]

Hi! Please, try this simple code:

Sub Format_If()
'Format as needed all paras that are preceded by an empty para and start with Mon, Tue, Wed, Thu, Fri, Sat, Sun plus space.
Dim myRng As range
    Application.ScreenUpdating = False
    Set myRng = ActiveDocument.range
    With myRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = "^13^13[FMSTW][aehoru][deintu] "
        .Replacement.text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        Do While .Execute
            myRng.start = myRng.start + 2
            myRng.Paragraphs(1).range.Font.Bold = True
            myRng.Paragraphs(1).range.Font.Size = 14
            myRng.Collapse wdCollapseEnd
        Loop
    End With
    Application.ScreenUpdating = False
    Set myRng = Nothing
End Sub

[macropod]

You could use a wildcard Find/Replace, with
Find = <[MTWFS][ondayueshrit]{2,7} [JFMASOND][anuryebchpilgstmov]{2,8} [0-9]{1,2} [0-9]{2,4}*^13
Replace = ^&
setting the replacement font to 14pt bold.
This will capture the dates regardless of whether the days & months are abbreviated or written out in full and whether the years are 2-digit or 4-digit.

If there is anything else on the line before the date, change the '<' at the start of the Find expression to '[!^13]@'

No macro required.

As a macro, it becomes:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Font.Bold = True
    .Replacement.Font.Size = 14
    .Execute FindText:="<[MTWFS][ondayueshrit]{2,7} [JFMASOND][anuryebchpilgstmov]{2,8} [0-9]{1,2} [0-9]{2,4}*^13", _
    ReplaceWith:="^&", MatchWildcards:=True, Forward:=True, Format:=True, Wrap:=wdFindContinue, Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

[macropod]

Originally Posted by vivka

Hi! Please, try this simple code:

FWIW, your

        Do While .Execute
            myRng.start = myRng.start + 2
            myRng.Paragraphs(1).range.Font.Bold = True
            myRng.Paragraphs(1).range.Font.Size = 14
            myRng.Collapse wdCollapseEnd
        Loop

could be reduced to:

        Do While .Execute
            myRng.Paragraphs.Last.Range.Font.Bold = True
            myRng.Paragraphs.Last.ange.Font.Size = 14
            myRng.Collapse wdCollapseEnd
        Loop

Not using a loop is more efficient, though. Regardless, you're not testing for full dates, so there's a risk of spurious matches (e.g. 'May I go now', 'The quick brown fox', 'She went home').

[vivka]

Yes, Macropod, I fully agree! Thank you for your useful remarks!