VBA to find and bold only certain words in one cell

trishcollins

trishcollins

New Member
Joined
Jan 7, 2006
Messages
45
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?

VBA Code: 
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
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
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

1716393172716.png


to

1716393223372.png


which appears right to me
 
Upvote 0
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
 
Upvote 0
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)
 
Upvote 0
If a cell contains a formula, then you cannot format a portion of it. It's all or nothing.
 
Upvote 0
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.

VBA Code: 
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:
1716400426544.png


Trish :)
 

Attachments

  • 1716400311244.png
    1716400311244.png
    22 KB · Views: 0
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

trishcollins
  • Solved
Excel vba set bold specific text of string into the cell in Pivot table.
Replies
2
Views
49
trishcollins
trishcollins
J
  • Solved
Problem infinite loop - find and bold based on cell value
Replies
2
Views
386
jptaz
J
Y
  • Solved
Highlighting selected words in a column.
Replies
6
Views
287
Akuini
Akuini
J
  • Question
Finding one word in a string and outputting the word in the same row
Replies
3
Views
349
Peter_SSs
Peter_SSs
Pinaceous
  • Question
vba capitalize 1st letter of each word then exit sub after correction
Replies
3
Views
301
Alex Blakenburg
A

Forum statistics

Threads
1,216,500
Messages
6,131,016
Members
449,615
Latest member
Nic0la

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top