Macro to Bold tet within wrapped text in B2

[howard]

I have code below to bold this portion of text "Do NOT amend my links." in B2 that contains other text as well that is wrapped

It would be appreciated if someone coild amend my code

Sub BoldTextInCell()
    Dim searchText As String
    Dim cellText As String
    Dim cellRange As Range
    Dim startPos As Long
    Dim found As Boolean

    ' Set the text you want to bold
    searchText = "Do NOT amend my links"

    ' Set the cell range
    Set cellRange = ThisWorkbook.Sheets("Email").Range("B2")

    ' Get the cell's text
    cellText = cellRange.Value

    ' Initialize the starting position
    startPos = 1
    found = False

    Do
        startPos = InStr(startPos, cellText, searchText, vbTextCompare)
        If startPos > 0 Then
            cellRange.Characters(startPos, Len(searchText)).Font.Bold = True
            startPos = startPos + 1
            found = True
        End If
    Loop While startPos > 0

    ' Display a message if the text was not found
    If Not found Then
        MsgBox "Text not found in the cell."
    End If
End Sub

 

[Legacy 143009]

Hi,

This should work:

Sub BoldTextInCell()
    Dim searchText As Variant, str As Variant
    Dim cellText As String
    Dim cellRange As Range
    Dim startPos As Long
    Dim found As Boolean

    ' Set the cell range
    Set cellRange = ThisWorkbook.Sheets("Email").Range("B2")

    ' Get the cell's text
    cellText = cellRange.Value

    ' Initialize the starting position
    startPos = 1
    found = False
 
    ' Set the text you want to bold
    searchText = Array("Do NOT amend my links", "Your other text", "You can add more")
    For Each str In searchText
      Do
          startPos = InStr(startPos, cellText, str, vbTextCompare)
          If startPos > 0 Then
              cellRange.Characters(startPos, Len(str)).Font.Bold = True
              startPos = startPos + 1
              found = True
          End If
      Loop While startPos > 0
    Next
    ' Display a message if the text was not found
    If Not found Then
        MsgBox "Text not found in the cell."
    End If
End Sub

 

[howard]

Many Thanks for your code

I get a run time error with this portion of the code

  startPos = InStr(startPos, cellText, str, vbTextCompare)

 

[Legacy 143009]

Ok, try to exit loop after str found. Also it will be faster I guess.

Sub BoldTextInCell()
    Dim searchText As Variant, str As Variant
    Dim cellText As String
    Dim cellRange As Range
    Dim startPos As Long
    Dim found As Boolean

    ' Set the cell range
    Set cellRange = ThisWorkbook.Sheets("Email").Range("B2")

    ' Get the cell's text
    cellText = cellRange.Value

    ' Initialize the starting position
    startPos = 1
    found = False
 
    ' Set the text you want to bold
    searchText = Array("Do NOT amend my links", "Your other text", "You can add more")
    For Each str In searchText
      Do
          startPos = InStr(startPos, cellText, str, vbTextCompare)
          If startPos > 0 Then
              cellRange.Characters(startPos, Len(str)).Font.Bold = True
              startPos = startPos + 1
              found = True
              Exit Do
          End If
      Loop
    Next
    ' Display a message if the text was not found
    If Not found Then
        MsgBox "Text not found in the cell."
    End If
End Sub

Also you won't need the while condition.

 

[howard]

Still get a run time

Please find link below of sample file

Email Schedules Test.xlsm

Shared with Dropbox

www.dropbox.com

 

[Legacy 143009]

Tested:

Sub BoldTextInCell()
    Dim searchText As Variant, str As Variant
    Dim cellText As String
    Dim cellRange As Range
    Dim startPos As Long
    Dim found As Boolean

    ' Set the cell range
    Set cellRange = ThisWorkbook.Sheets("Email").Range("B2")

    ' Get the cell's text
    cellText = cellRange.Value

    ' Initialize the starting position
    found = False
 
    ' Set the text you want to bold
    searchText = Array("Do NOT amend my links", "finalise", "check")
    For Each str In searchText
      startPos = 1
      Do
          startPos = InStr(startPos, cellText, str, vbTextCompare)
          If startPos > 0 Then
              cellRange.Characters(startPos, Len(str)).Font.Bold = True
              startPos = startPos + 1
              found = True
          End If
      Loop While startPos > 0
    Next
    ' Display a message if the text was not found
    If Not found Then
        MsgBox "Text not found in the cell."
    End If
End Sub

I don't know why but it doesn't work good with the formula.

 

[bebo021999]

in code:
searchText = Array("Do NOT amend my links", "finalise", "check")
but in cell
"Do NOT amend any of my links"

 

[Legacy 143009]

in code:
searchText = Array("Do NOT amend my links", "finalise", "check")
but in cell
"Do NOT amend any of my links"

Yes, considering that, I moved the start position in For loop.

 

[Georgiboy]

Looking at the sample file in post #5, the text that you see is the result of a formula, you are not going to be able to bold part of the result from a formula.

I assume you want to keep the formula though. You could move your formula to another sheet and move the value to where you want it. In the below example, your formula would be in cell A1 of the 'Macro' sheet (could be anywhere), the code will bring in the value from that sheet and then make the requested line bold:

Sub BoldWithFind()
    Dim rCell As Range, rStr As String
   
    Set rCell = Range("B2")
   
    rCell = Sheets("Macro").Range("A1").Value
   
    rStr = "Do NOT amend any of my links."
    rCell.Characters(InStr(rCell, rStr), Len(rStr)).Font.Bold = True
End Sub

 

[Georgiboy]

Here is an option where you create your text string in VBA rather than the formula:

Sub BoldWithFind()
    Dim rCell As Range, rStr As String, dCell As Range
   
    Set rCell = Range("B2") ' target cell
    Set dCell = Range("F1") ' date cell
    rStr = "Do NOT amend any of my links."

    rCell = _
        "Good Morning Guys" & vbNewLine & vbNewLine & _
        "Just a reminder to let me have your schedules by no later than " & Format(Range("F1"), "dd/mm/yyyy.") & vbNewLine & vbNewLine & _
        "Should these be completed, let me have these so I can check and finalise." & vbNewLine & vbNewLine & _
        rStr & vbNewLine & vbNewLine & _
        "Regards" & vbNewLine & vbNewLine & _
        "Howard"

    rCell.Characters(InStr(rCell, rStr), Len(rStr)).Font.Bold = True
End Sub