VBA help

[sksanjeev786]

Hi Team,

I need support on VBA i have a data with Image 1 and after applying data I am getting RGB in Image 2 so

So Below are things I want to remove from Image 2
1. Remove "p","q", and "r" letter from the table except "Ctrl"
2. color is coming for me but due to "Ctrl" orange color is coming in all the table so I have to exclude "Ctrl" while applying condition and after that remove all p,q, r

Public Sub HighlightBoldWhitenAndRemoveLetters()

    Dim ActiveShape As Shape
    Dim shp As Shape
    Dim objTable As Table
    Dim targetColumn As Long
    Dim targetRow As Long
    Dim cell As cell
    Dim rng As TextRange
    Dim i As Long
    Dim charSize As Single
    Dim charText As String
    Dim cellText As String

    Select Case Application.ActiveWindow.Selection.Type
        Case ppSelectionShapes, ppSelectionText
            For Each shp In Application.ActiveWindow.Selection.ShapeRange
                Set ActiveShape = shp
                Exit For
            Next shp
        Case Else
            MsgBox "There is no shape currently selected!", vbExclamation, "No Shape Found"
            Exit Sub
    End Select

    If ActiveShape.HasTable Then
        Set objTable = ActiveShape.Table

        For targetRow = 4 To objTable.Rows.Count
            For targetColumn = 2 To objTable.Columns.Count
                Set cell = objTable.cell(targetRow, targetColumn)
                Set rng = cell.Shape.TextFrame.TextRange
                cellText = rng.Text

                cell.Shape.Fill.Visible = msoFalse

                Dim bgColor As Long
                bgColor = RGB(255, 255, 255)

                If InStr(1, LCase(cellText), "p") > 0 Then
                    bgColor = RGB(79, 138, 16) ' Green for "p"
                ElseIf InStr(1, LCase(cellText), "r") > 0 Then
                    bgColor = RGB(255, 150, 0) ' Red for "r"
                ElseIf InStr(1, LCase(cellText), "q") > 0 Then
                    bgColor = RGB(204, 51, 51) ' Orange for "q"
                End If

                If bgColor <> RGB(255, 255, 255) Then
                    cell.Shape.Fill.ForeColor.RGB = bgColor
                    cell.Shape.Fill.Visible = msoTrue
                End If

               
                For i = 1 To rng.Characters.Count
                    With rng.Characters(i, 1).Font
                        charSize = .Size
                        charText = rng.Characters(i, 1).Text
                        If charSize = 12 Then
                          
                            If InStr(1, LCase(charText), "p") > 0 Then
                                .Color.RGB = RGB(255, 255, 255) ' White for "p"
                            ElseIf InStr(1, LCase(charText), "r") > 0 Then
                                .Color.RGB = RGB(255, 255, 255) ' White for "r"
                            ElseIf InStr(1, LCase(charText), "q") > 0 Then
                                .Color.RGB = RGB(255, 255, 255) ' White for "q"
                            Else
                                .Color.RGB = RGB(0, 0, 0) ' Black for other text
                            End If
                        End If
                    End With
                Next i

                For i = 1 To rng.Characters.Count
                    With rng.Characters(i, 1).Font
                        If .Size = 6 Then
                           
                            If InStr(1, LCase(rng.Characters(i, 1).Text), "p") > 0 Then
                                .Color.RGB = RGB(255, 255, 255) ' White
                            ElseIf InStr(1, LCase(rng.Characters(i, 1).Text), "r") > 0 Then
                                .Color.RGB = RGB(255, 255, 255) ' White
                            ElseIf InStr(1, LCase(rng.Characters(i, 1).Text), "q") > 0 Then
                                .Color.RGB = RGB(255, 255, 255) ' White
                            Else
                                .Color.RGB = RGB(0, 0, 0) ' Black
                            End If
                        End If
                    End With
                Next i

            Next targetColumn
        Next targetRow
    Else
        MsgBox "The selected shape is not a table!", vbExclamation, "Table Not Found"
    End If
End Sub

 

[Micron]

Wrap this If block

If InStr(1, LCase(cellText), "p") > 0 Then

in another If block?
If Not Instr(cellText,"Ctrl")>0 Then

The intention there is to say if Ctrl is found at position 5, the expression becomes 'if 5>0 is false then do what follows'. So if Ctrl is found, what is contained in the If block that follows should not be executed.