Excel vba set bold specific text of string into the cell in Pivot table.

[trishcollins]

I found this code and altered it for my specific needs. I want a bunch of text highlighted in a Pivot table. The text is from a concatenated string from the source data table. The first time I run the code and refresh the Pivot table, it works great. Bolding and bolding and underlining on the text in the array. The second and subsequent times I refresh the Pivot table it bolds and underlines everything. Obviously, this is not ideal, given that I refresh the pivot table often as the source data changes. Is there any way to fix it?

Sub Find_and_Bold()
Dim rCell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 17) As String
Dim i As Integer
Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables(1)


Text(1) = "Client Input"
Text(2) = "Results"
Text(3) = "Change Type:"
Text(4) = "Explanation:"
Text(5) = "Preferred Network Connectivity:"
Text(6) = "Preferred Network Path:"
Text(7) = "Preferred Network Connectivity for Remotely Connected Source Entity:"
Text(8) = "Network Path for Remotely Connected Source Entity:"
Text(9) = "Connectivity Notes:"
Text(10) = "Network Path Notes:"
Text(11) = "Business Need:"
Text(12) = "TBS Connectivity Pattern:"
Text(13) = "Target CSP:"
Text(14) = "Type:"
Text(15) = "Access Zone:"
Text(16) = "Conditions:"
Text(17) = "Source Entity:"

For Each rCell In pt.DataBodyRange
    For i = LBound(Text) To UBound(Text)
            sToFind = Text(i)
            iSeek = InStr(1, rCell.Value, sToFind)
        Do While iSeek > 0
            rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
            If i <= 2 Then
                rCell.Characters(iSeek, Len(sToFind)).Font.Underline = True
            Else
            End If
            iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
        Loop
    Next i
Next rCell

End Sub

First time I refresh the pivot table:

Subsequent refreshes:

Trish

 

[trishcollins]

I found this code and altered it for my specific needs. I want a bunch of text highlighted in a Pivot table. The text is from a concatenated string from the source data table. The first time I run the code and refresh the Pivot table, it works great. Bolding and bolding and underlining on the text in the array. The second and subsequent times I refresh the Pivot table it bolds and underlines everything. Obviously, this is not ideal, given that I refresh the pivot table often as the source data changes. Is there any way to fix it?

Sub Find_and_Bold()
Dim rCell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 17) As String
Dim i As Integer
Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables(1)


Text(1) = "Client Input"
Text(2) = "Results"
Text(3) = "Change Type:"
Text(4) = "Explanation:"
Text(5) = "Preferred Network Connectivity:"
Text(6) = "Preferred Network Path:"
Text(7) = "Preferred Network Connectivity for Remotely Connected Source Entity:"
Text(8) = "Network Path for Remotely Connected Source Entity:"
Text(9) = "Connectivity Notes:"
Text(10) = "Network Path Notes:"
Text(11) = "Business Need:"
Text(12) = "TBS Connectivity Pattern:"
Text(13) = "Target CSP:"
Text(14) = "Type:"
Text(15) = "Access Zone:"
Text(16) = "Conditions:"
Text(17) = "Source Entity:"

For Each rCell In pt.DataBodyRange
    For i = LBound(Text) To UBound(Text)
            sToFind = Text(i)
            iSeek = InStr(1, rCell.Value, sToFind)
        Do While iSeek > 0
            rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
            If i <= 2 Then
                rCell.Characters(iSeek, Len(sToFind)).Font.Underline = True
            Else
            End If
            iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
        Loop
    Next i
Next rCell

End Sub

First time I refresh the pivot table:
View attachment 111719

Subsequent refreshes:
View attachment 111721

Trish

Thought I found my own fix. I added the following code before running the loop, and cleared the Pivot table of bold and underline. But doesn't fix the problem

pt.DataBodyRange.Font.Bold = False
pt.DataBodyRange.Font.Underline = False

 

[trishcollins]

Thought I found my own fix. I added the following code before running the loop, and cleared the Pivot table of bold and underline. But doesn't fix the problem

pt.DataBodyRange.Font.Bold = False
pt.DataBodyRange.Font.Underline = False

This did work when I made this specific to the worksheet, as I had more than one Pivot table in the workbook.