How to change cells colors in specified columns?

user_18649290 0
Viewed 255

I picked up this code to select and change the interior color (green) of the EntireRow when the AtiveCell is behind the 6 Row.

I need to select and change the interior color (Color = 9359529) of the column "I" and "J" of the Row where is the ActiveCell. Is similar to this code but do not need the entire row, just the columns I and J.

Dim lTarget As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
    If Target.Row >= 6 Then
       
        If Not lTarget Is Nothing Then
            lTarget.EntireRow.Interior.ColorIndex = 0
        End If
        
        Target.EntireRow.Interior.Color = 9359529
        Set lTarget = Target

    End If

End Sub
cell vba excel colors
2 Answers

Using just your example and what I think you're asking this is the simplest way to do what I think you're asking.

You either have just one row in the selection - or you just want the first row changed

This can be changed to use a Range object - but this is easy to understand

Dim lTarget As Range
Const TargetCol1    As Integer = 9
Const TargetCol2    As Integer = 10

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
    If Target.Row >= 6 Then
        If Not lTarget Is Nothing Then
            lTarget.EntireRow.Interior.ColorIndex = 0
        End If
        
        Cells(Target.Row, TargetCol1).Interior.Color = 9359529
        Cells(Target.Row, TargetCol2).Interior.Color = 9359529
        
        Set lTarget = Target
    End If
End Sub
user_24191280

A Worksheet SelectionChange

  • Many thanks to Tragamor for pointing out the many flaws of my previous attempts.
Option Explicit

Private lTarget As Range
Private FirstPassed As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Const FirstRow As Long = 6
    Const Cols As String = "I:J"
    Const iColor As Long = 9359529
    
    Dim rrg As Range
    Set rrg = Rows(FirstRow).Resize(Rows.Count - FirstRow + 1)
    Dim irg As Range: Set irg = Intersect(rrg, Target)
    If Not irg Is Nothing Then Set irg = Intersect(irg.EntireRow, Columns(Cols))
    
    If FirstPassed Then
        If irg Is Nothing Then
            If Not lTarget Is Nothing Then
                lTarget.Interior.ColorIndex = xlNone
                Set lTarget = Nothing
            End If
        Else
            If Not lTarget Is Nothing Then
                lTarget.Interior.ColorIndex = xlNone
            End If
            irg.Interior.Color = iColor
            Set lTarget = irg
        End If
    Else
        rrg.Columns(Cols).Interior.ColorIndex = xlNone
        If Not irg Is Nothing Then
            irg.Interior.Color = iColor
            Set lTarget = irg
        End If
        FirstPassed = True
    End If

End Sub
user_98140690
Related