简体   繁体   中英

vba conditional formatting with Worksheet_SelectionChange

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).

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM