vba conditional formatting with Worksheet_SelectionChange

1
votes

I'm trying to conditionally format cells in a range using VBA. My goal is that every time a cell is selected, every cell which holds the same text will be formatted.

My code:

Private Sub Worksheet_SelectionChange(ByVal t As Range)    
   Cells.FormatConditions.Delete
   Range("B2:K29").Select
   Selection.FormatConditions.Add Type:=xlTextString, String:=t.Value, _
    TextOperator:=xlContains
   With Selection.FormatConditions(1).Font
    .Bold = True
    .Italic = False
    .TintAndShade = 0
   End With
End Sub

The problem is that every time I select a cell, all the cells in the range are formatted (and not just the ones which have the same text as in the selected cell).

2
vbaexcelconditional-formatting
Have you tried recording a macro and setting this format to see if your code is OK ? – nicolas
Have you looked at the conditional formatting window? What is it displaying as the condition? – Degustaf

2 Answers

2
votes

This works for me:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim c As Range

    Set c = Target.Cells(1)
    Me.Cells.FormatConditions.Delete

    If Len(c.Value) > 0 Then

     With Me.Range("B2:K29").FormatConditions.Add(Type:=xlTextString, _
                       String:=c.Value, TextOperator:=xlContains)
         With .Font
          .Bold = True
          .Italic = False
          .TintAndShade = 0
         End With
     End With
    End If
End Sub
0
votes

What you want done is already provided by Tim so select his answer.
I'll just post this as another approach for anyone who might stumble in this question.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo halt
    Application.EnableEvents = False
    Me.Cells.FormatConditions.Delete
    If Target.Cells.Count = 1 And Not IsEmpty(Target) Then
        With Me.Range("A1").FormatConditions.Add(Type:=xlTextString, _
                     String:=Target.Value, TextOperator:=xlContains)
            With .Font
                .Bold = True
                .Italic = False
                .TintAndShade = 0
            End With
            .ModifyAppliesToRange Me.Range("B2:K29")
        End With
    End If
forward:
    Application.EnableEvents = True
    Exit Sub
halt:
    MsgBox Err.Description
    Resume forward
End Sub