VBA to find and bold only certain words in one cell

[trishcollins]

So, I used some other code I had written to find and bold words in the body of a Pivot table and automatically run whenever the Pivot table refreshes. I works fine. The range I have setup for that was the PivotBodyRange. I now have a requirement to find and bold certain words in one cell (A1) of the same worksheet. The code bolds everything. I am obviously doing something wrong. Any suggestions?

Sub Find_and_Bold_Tombstone()

Dim rcell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 13) As String
Dim Wksh As Worksheet
Dim i As Integer
Dim Rng As Range

Text(1) = "Project Name"
Text(2) = "Client Contact Info"
Text(3) = "DGEAS Contact Info:"
Text(4) = "Explanation:"
Text(5) = "JDCP Contact Info:"
Text(6) = "JDCP Intake Number:"
Text(7) = "CEIP-4 Contact Info:"
Text(8) = "Total Use Case"
Text(9) = "Simple Use Cases Requiring Assyst Tickets ONLY:"
Text(10) = "Complex Uses Case Requiring a BRD:"
Text(11) = "Date File Created:"
Text(12) = "Date Last Updated:"
Text(13) = "Document Version:"

Set Wksh = Worksheets("Use Case Details")
Set Rng = Wksh.Range("A1")

Rng.Font.Bold = False
Rng.Font.Underline = False

Rng.Select
For i = LBound(Text) To UBound(Text)
        sToFind = Text(i)
        iSeek = InStr(1, Rng.Value, sToFind)
    Do While iSeek > 0
            Rng.Characters(iSeek, Len(sToFind)).Font.Bold = True
            iSeek = InStr(iSeek + 1, Rng.Value, sToFind)
        Loop
    Next i
End Sub

 

[MARK858]

Can you post a sample of your data using the boards XL2BB addin please as your code appears to work for me (the only thing I altered was the sheet to ActiveSheet for testing).

I went from

to

which appears right to me

 

[trishcollins]

Here is what is in cell A1. When I run it just for this worksheet, everything gets bolded.

Project Name: MILPAY Phase 2, Date File Created: Apr-29-2024, Date Last Updated: May-02-2024, Document Version: 45411 Client Contact Info: DGEAS Contact Info: JDCP Contact Info: , JDCP Intake Number: CEIP-4 Contact Info: PM: Will Rado, BA: Martin Saintonge, Network Architect: Trish Collins, TA: Marc Belanger Total Use Cases: 12, Simple Use Cases Requiring Assyst Tickets ONLY: 12, Complex Uses Case Requiring a BRD: 0

 

[trishcollins]

I think I know why it's not working, but not sure how to fix it. It's a formula. If I copy and paste back as a value, then it works. Any way I can apply this to a formula?

=CONCAT("Project Name: ",Project_Name, ", Date File Created: ",TEXT(Date_File_Created,"mmm-dd-yyyy"),", Date Last Updated: ",TEXT(Date_File_Last_Updated,"mmm-dd-yyyy"), ", Document Version: ",TEXT('Project and Contact Info'!C3,"v#.0"),CHAR(10),"Client Contact Info: ",Client_Contact_Info, CHAR(10),"DGEAS Contact Info: ",DGEAS_Contact_Info,CHAR(10),"JDCP Contact Info: ",JDCP_Contact_Info, ", JDCP Intake Number: ",JDCP_Intake_Number, CHAR(10), "CEIP-4 Contact Info: ",CEIP4_Contact_Info,CHAR(10),"Total Use Cases: ",(Simple_Use_Cases_Count+Complex_Use_Cases_Count),", Simple Use Cases Requiring Assyst Tickets ONLY: ",Simple_Use_Cases_Count, ", Complex Uses Case Requiring a BRD: ",Complex_Use_Cases_Count)

 

[Fluff]

If a cell contains a formula, then you cannot format a portion of it. It's all or nothing.

 

[trishcollins]

Fixed. I took the formula and put it into a hidden column. Then when they refresh, it copies the formula intact, so the values are updated, and then I do a copy and paste values and run the code to bold. That works.

Private Sub Find_and_Bold_Tombstone()

Dim rcell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 12) As String
Dim Wksh As Worksheet
Dim i As Integer
Dim Rng As Range

Text(1) = "Project Name"
Text(2) = "Date File Created:"
Text(3) = "Date Last Updated:"
Text(4) = "Document Version:"
Text(5) = "Client Contact Info"
Text(6) = "DGEAS Contact Info:"
Text(7) = "JDCP Contact Info:"
Text(8) = "JDCP Intake Number:"
Text(9) = "CEIP-4 Contact Info:"
Text(10) = "Total Use Case"
Text(11) = "Simple Use Cases Requiring Assyst Tickets ONLY:"
Text(12) = "Complex Uses Case Requiring a BRD:"

Set Wksh = Worksheets("Use Case Summary")
Set Rng = Wksh.Range("A1")

    Wksh.Range("D1").Select
    Selection.Copy
    Rng.Select
    Wksh.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Rng.Font.Bold = False
Rng.Font.Underline = False

Rng.Select
For i = LBound(Text) To UBound(Text)
        sToFind = Text(i)
        iSeek = InStr(1, Rng.Value, sToFind)
    Do While iSeek > 0
            Rng.Characters(iSeek, Len(sToFind)).Font.Bold = True
            iSeek = InStr(iSeek + 1, Rng.Value, sToFind)
        Loop
    Next i
End Sub

Results:

Trish