VBA Bold text before first colon only

Shelley Lou · #1 06-12-2024, 09:41 AM

Hi, I have some code that makes the first words (Defined Terms) at the beginning of paragraphs bold if they are before a tab or a colon. There is an issue if there are additional colons within the same paragraph (see image) or if the colon comes at the end of the paragraph before the tab, it formats those words bold also.

I'm trying to get the code to only bold the words at the beginning of the paragraph before a tab or colon and also if the defined term has quote marks to remove the quotes and bolden the words. I've added before and after documents.

Can anyone advise me on how to get the code to only change the words at the beginning of the paragraphs to bold and nothing else. Thanks

Capture.JPG

Bold Text Before Formatting.docx
Bold Text After Formatting.docx

Code:

Sub BoldBeforeTabsAndColons_Definitions()
'Find text at beginning of paras before tab or colon and format bold without quotes
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
With Selection.Find
  .ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchWildcards = True
  .Replacement.ClearFormatting
  .text = "([!^13]@^t)" 'bold text before tab beginning of para
  .Replacement.text = "\1"
  .Replacement.Font.Bold = True
  .Execute Replace:=wdReplaceAll
  .text = "^13(\([a-z]{1,}\))"
  .Replacement.text = "^p\1"
  .Replacement.Font.Bold = False
  .Execute Replace:=wdReplaceAll
  .text = "([!^13]@:)" 'bold text before colon beginning of para
  .Replacement.text = "\1"
  .Replacement.Font.Bold = True
  .Execute Replace:=wdReplaceAll
  .text = "^13(\([a-z]{1,}\))"
  .Replacement.text = "^p\1"
  .Replacement.Font.Bold = False
  .Execute Replace:=wdReplaceAll
  End With
  Application.ScreenUpdating = True
End Sub

Guessed · #2 06-13-2024, 04:05 AM

Try this approach - you need to select the paragraphs you want to examine first.

Code:

Sub BoldOfYouSir()
  Dim aPar As Paragraph, iColon As Integer, iTab As Integer, aRng As Range, iFirst As Integer
  For Each aPar In Selection.Range.Paragraphs
    Set aRng = aPar.Range
    iColon = InStr(aRng.Text, ":")
    iTab = InStr(aRng.Text, vbTab)
    If iColon > 0 Then
      If iTab = 0 Then
        aRng.End = aRng.Start + iColon
      Else
        iFirst = IIf(iColon < iTab, iColon, iTab)
        aRng.Collapse Direction:=wdCollapseStart
        aRng.End = aRng.Start + iFirst
      End If
      aRng.Font.Bold = True
    ElseIf iTab > 0 Then
      aRng.End = aRng.Start + iTab
      aRng.Font.Bold = True
    End If
  Next aPar
End Sub

Edit: I see you added sample files and the list elements are hard coded. The code I provided ignores automatic numbering but treats those hard coded lists as if they contain a tab (which they do). I don't know how your real source lists are done so this code may or may not be what you wanted.

gmaxey · #3 06-13-2024, 04:10 AM

Code:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oRng As Range
   Set oRng = ActiveDocument.Range
   With oRng.Find
     .ClearFormatting
     .Forward = True
     .Wrap = wdFindContinue
     .Format = True
     .MatchWildcards = True
     .Replacement.ClearFormatting
      'Get rid of quotes
     .Text = "(" & Chr(34) & ")([A-Z][!^13]@)(" & Chr(34) & ")([^t:])"
     .Replacement.Text = "\2\4"
     .Execute Replace:=wdReplaceAll
     'Bold terms
     .Text = "([A-Z][!^13]@[^t:])"
     .Replacement.Text = "\1"
     .Replacement.Font.Bold = True
     .Execute Replace:=wdReplaceAll
   End With
lbl_Exit:
   Exit Sub
End Sub

Shelley Lou · #4 06-13-2024, 05:33 AM

Hi Andrew and Greg, thank you so much for your replies. I've test both codes and have attached two documents with the results.

Andrews Code.docx
Gregs Code.docx

Andrew, the text to run the code will always be unformatted text copied from a converted pdf so the lists will always be manual numbered lists - I have another macro to do all the other formatting tasks e.g. auto numbering. In your code it needs to have a function to remove the quote marks and not bold the numbered lists.

Greg, your code came very close to being perfect. As with all converted documents the formatting can be hit and miss in terms of tabs and spaces so the only thing it didn't update was if the quoted text had a space instead of a tab and if the bold colons could be removed and replaced with a tab.

I really appreciate the help you have both given me on this.

vivka · #5 06-13-2024, 08:16 AM

Hi, Shelley Lou! This simple macro seems to do the job:

Code:

Sub Format_Paras_If()
'In active doc's paras that have a tab/colon, bold the strings
'from paras start until the 1st tab/colon excluding list paras.
'Coded by vivka, 12.06.2024

Dim oRng As range
    Application.ScreenUpdating = False
    Set oRng = ActiveDocument.range
    With oRng.Find
        .ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        .Replacement.ClearFormatting
        .text = "[^t:]"
        Do While .Execute And oRng.ListFormat.ListType = 0
            oRng.End = oRng.start
            oRng.start = oRng.Paragraphs(1).range.start
            oRng.Font.Bold = True
            oRng.start = oRng.Paragraphs(1).range.End
        Loop
    End With
Application.ScreenUpdating = True
Set oRng = Nothing
End Sub

Shelley Lou · #6 06-13-2024, 08:33 AM

Hi Vivka

Thank you for taking the time to reply to my post. Unfortunately, your code does the same as Andrew's code, quotes need to be removed and the manual numbering should not be bold.

Vivka Code.docx

vivka · #7 06-13-2024, 09:30 AM

Yes, my code is good for automatic numbering. To make a proper macro, some points should be cleared up:
1) do you always use manual numberings?
2) what kind(s) of numbering do you use, e.g.: a) or 1) or a. or 1. or (a) or (1) or (i) or i. or i), etc.?

Shelley Lou · #8 06-13-2024, 11:55 AM

Hi Vivka

Yes only manual numbering for this part of the code, I have further code once all the formatting has been completed that converts the lists to auto.

Number sequence will be either: (a), (i), (A), (1) or a), i), A), 1) depending on the conversion from the pdf.

gmaxey · #9 06-13-2024, 02:35 PM

Code:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oRng As Range
   Set oRng = ActiveDocument.Range
   With oRng.Find
     .ClearFormatting
     .Forward = True
     .Wrap = wdFindContinue
     .Format = True
     .MatchWildcards = True
     .Replacement.ClearFormatting
      'Get rid of quotes
     .Text = "(" & Chr(34) & ")([A-Z][!^13]@)(" & Chr(34) & ")([ ^t:])"
     .Replacement.Text = "\2^t"
     .Execute Replace:=wdReplaceAll
     'Bold terms
     .Text = "([A-Z][!^13]@)([^t:])"
     .Replacement.Text = "\1^t"
     .Replacement.Font.Bold = True
     .Execute Replace:=wdReplaceAll
   End With
lbl_Exit:
   Exit Sub
End Sub

Shelley Lou · #10 06-14-2024, 12:23 AM

Hi Greg, thank you so much for the updated code. I've run it on a larger set of definitions to be converted and a few things happened. I've added 0-9 to the code to deal with legislation definitions that start with a number. It has also boldened some text it shouldn't and has removed the colon from these also.

'this Lease' hasn't picked up the word 'this' which I suspect is because the code is only looking for initial caps.

Non-Structure Alteration at sub level (b) its changed the line to bold and has removed the colon and inserted a tab - same for Property and Regulations - is this because there are initial cap words within the sentence?

TEST RUN.docx

Code:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oRng As Range
   Set oRng = ActiveDocument.Range
   With oRng.Find
     .ClearFormatting
     .Forward = True
     .Wrap = wdFindContinue
     .Format = True
     .MatchWildcards = True
     .Replacement.ClearFormatting
      'Get rid of quotes
     .text = "(" & Chr(34) & ")([A-Z0-9][!^13]@)(" & Chr(34) & ")([ ^t:])"
     .Replacement.text = "\2^t"
     .Execute Replace:=wdReplaceAll
     'Bold terms
     .text = "([A-Z0-9][!^13]@)([^t:])"
     .Replacement.text = "\1^t"
     .Replacement.Font.Bold = True
     .Execute Replace:=wdReplaceAll
   End With
lbl_Exit:
   Exit Sub
End Sub

gmaxey · #11 06-14-2024, 04:34 AM

Shelley

We will have to drop back and check each found instance to ensure is starts at the beginning of the paragraph.

Code:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchWildcards = True
    .Replacement.ClearFormatting
    'Get rid of quotes
    .Text = "(" & Chr(34) & ")([A-Z0-9][!^13]@)(" & Chr(34) & ")([ ^t:])"
    .Replacement.Text = "\2^t"
    .Execute Replace:=wdReplaceOne
    'Bold terms
    .Text = "([a-zA-Z0-9][!^13]@)([^t:])"
    .Replacement.Text = "\1^t"
    .Replacement.Font.Bold = True
    While .Execute
       If oRng.Characters(1).Start = oRng.Paragraphs(1).Range.Characters(1).Start Then
         oRng.Font.Bold = True
         oRng.Text = Replace(oRng.Text, ":", vbTab)
       End If
    Wend
  End With
lbl_Exit:
   Exit Sub
End Sub

Shelley Lou · #12 06-14-2024, 06:07 AM

Hi Greg, I've just run the code and attach the results. It seems to have missed the first three definitions and any definitions with quote marks.

Gregs Code 2.docx

gmaxey · #13 06-14-2024, 06:25 AM

I'm striking out today:

Code:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchWildcards = True
    .Replacement.ClearFormatting
    'Get rid of quotes
    .Text = "(" & Chr(34) & ")([A-Z0-9][!^13]@)(" & Chr(34) & ")([ ^t:])"
    .Replacement.Text = "\2^t"
    .Execute Replace:=wdReplaceAll
  End With
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchWildcards = True
    .Replacement.ClearFormatting
    'Bold terms
    .Text = "([a-zA-Z0-9][!^13]@)([^t:])"
    While .Execute
       If oRng.Characters(1).Start = oRng.Paragraphs(1).Range.Characters(1).Start Then
         oRng.Select
         oRng.Font.Bold = True
         If Not oRng.Characters.Last.Next = vbTab Then
           oRng.Text = Replace(oRng.Text, ":", vbTab)
         Else
           oRng.Characters.Last.Delete
         End If
       End If
    Wend
  End With
lbl_Exit:
   Exit Sub
End Sub

Shelley Lou · #14 06-14-2024, 06:43 AM

Hi Greg, I think your last code has done the trick - I've run it on a few test documents and all seems to be working ok - thank you so much for your time and patience, I really do appreciate it.

gmaxey · #15 06-14-2024, 11:07 AM

Glad to help.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Bold Term Macro that DOES NOT bold terms with Quotation Marks	NotOriginal	Word VBA	2	03-14-2024 02:22 PM
Bold Header if it is not Bold (Check to see if it is Bold)	armendarizj	Word	2	01-06-2022 05:45 PM
bold (or unbold) section of text instead of bold toggling	Burt	Word	6	04-06-2019 09:09 AM
Text in #1 is made bold, rest of the document is edited, text in #1 is now not bold	footer-assistance	Word	1	06-29-2015 03:49 AM
Not Bold text but it comes up bold	Pluviophile	Word	7	10-22-2013 10:29 AM