Formatting dates only in Diary transcriptions

RobinClay · #1 04-07-2025, 04:01 AM

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 · #2 04-07-2025, 12:46 PM

Hi! Please, try this simple code:

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 · #3 04-07-2025, 03:22 PM

Quote:

Originally Posted by vivka

Hi! Please, try this simple code:

FWIW, your

Code:

        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:

Code:

        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 · #4 04-08-2025, 02:53 AM

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

macropod · #5 04-07-2025, 03:12 PM

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:

Code:

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Diary template	RobinClay	Word	0	05-05-2023 03:22 PM
Formatting th at the end of ordinal dates	DBlomgren	Publisher	0	01-23-2016 09:44 AM
Conditional Formatting Dates	Phil H	Excel	6	12-08-2014 07:42 AM
Conditional Formatting Dates	jake.harris5253	Excel	1	12-06-2014 10:59 AM
Conditional Formatting with Dates	namedujour	Excel	1	02-21-2013 03:42 AM