Highlite row as opposed to currently working cell selection

[ipbr21054]

Morning,

I am using the code below where when a cell is selected then that cells interior color changes from yellow to blue.
When i then slected another cell this previously selected cell then reverts back to yellow.

You will see that column D and H have there own specific color & do not change to blue.

Please can you advise how to edit the code so when the is cell is selected it now turns that row blue as opposed to just that cell.
Still column D and H would have there own specific color

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("A8:I" & LastRow)) Is Nothing Then Exit Sub
    If Target.Column <> 4 And Target.Column <> 7 Then
        Range("A8:C" & LastRow).Interior.ColorIndex = 6
        Range("E8:F" & LastRow).Interior.ColorIndex = 6
        Range("H8:I" & LastRow).Interior.ColorIndex = 6
        Target.Interior.ColorIndex = 8
End Sub

 

[Snakehips]

Can you confirm:
Is whole row to be blue or just the row of your data ie columns A:I less D & H?

 

[ipbr21054]

Hi,
The column as before D and G are not to be affected by this new request.
These 2 columns should still use the old colour interior code.

So the anser to your question is A to I BUT NOT D & G

Many thanks

 

[Yongle]

Try this
Amend D2 to any cell that contains the same interior colour as colums B,D & G

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.ScreenUpdating = False
    Dim LastRow As Long, a As Variant
    Dim default As Long: default = Range("D2").Interior.ColorIndex
   
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("A8:I" & LastRow)) Is Nothing Then Exit Sub
    If Target.Column <> 4 And Target.Column <> 7 Then
        For Each a In Array("A8:C", "E8:F", "H8:I")
            Range(a & LastRow).Interior.ColorIndex = 6
        Next
        For Each a In Array("B8:D", "G8:G")
            Range(a & LastRow).Interior.ColorIndex = default
        Next
        Cells(Target.Row, 1).Resize(, 9).Interior.ColorIndex = 8
    End If
End Sub

 

[ipbr21054]

Hi,
That changes the row in questiuon fine BUT it also colours the whole column B C D G green from the row row to the last row.
I need the columns left alone.

In the row in question i only need cell in column A B C E F H I changed to blue

 

[Snakehips]

Try this tweak on Yongle's code...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.ScreenUpdating = False
    Dim LastRow As Long, a As Variant
    Dim default As Long: default = Range("D8").Interior.ColorIndex
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("A8:I" & LastRow)) Is Nothing Then Exit Sub
    If Target.Column <> 4 And Target.Column <> 7 Then
        For Each a In Array("A8:C", "E8:F", "H8:I")
            Range(a & LastRow).Interior.ColorIndex = 6
        Next
        Cells(Target.Row, 1).Resize(, 9).Interior.ColorIndex = 8
        For Each a In Array("D8:D", "G8:G")
            Range(a & LastRow).Interior.ColorIndex = default
        Next
        
    End If

 

[ipbr21054]

Yes & No

It colors the row in question fine.

But the cell at column D and G have there own specific color.
This is totaly removed & actually all of these two columns has the collor removed.

 

[Yongle]

It colors the row in question fine.
But the cell at column D and G have there own specific color.
This is totaly removed & actually all of these two columns has the collor removed.

amend the colours for D & G to match your own requirements

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.ScreenUpdating = False
    Dim LastRow As Long, a As Variant
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("A8:I" & LastRow)) Is Nothing Then Exit Sub
    If Target.Column <> 4 And Target.Column <> 7 Then
        For Each a In Array("A8:C", "E8:F", "H8:I")
            Range(a & LastRow).Interior.ColorIndex = 6
        Next   
        Range("D8:D" & LastRow).Interior.Color = RGB(0, 255, 0)
        Range("G8:G" & LastRow).Interior.Color = RGB(100, 255, 0)
        Cells(Target.Row, 1).Resize(, 9).Interior.ColorIndex = 8
    End If
End Sub

 

[ipbr21054]

Let me show you why i cant do that,see attached photo.
Unless im missing something ?

 

[Snakehips]

Try this...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.ScreenUpdating = False
    Dim LastRow, r As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    r = Target.Row
    If Intersect(Target, Range("A8:I" & LastRow)) Is Nothing Then Exit Sub
    If Target.Column <> 4 And Target.Column <> 7 Then
        Range("A8:C" & LastRow).Interior.ColorIndex = 6
        Range("E8:F" & LastRow).Interior.ColorIndex = 6
        Range("H8:I" & LastRow).Interior.ColorIndex = 6
        Range("A" & r & ":C" & r).Interior.ColorIndex = 8
        Range("E" & r & ":F" & r).Interior.ColorIndex = 8
        Range("H" & r & ":I" & r).Interior.ColorIndex = 8
        End If
End Sub