Existing working code to be exempt from a specific column

[ipbr21054]

Hi,
I am using the code supplied below to highlite columns / rows for easy visual purposes.
I am looking at this line of code,

Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8

My request would be to have no affect for column D
Currently it works like so,
Background of worksheet is yellow
Active row is blue
Active cell is green

When i select any cell on the worksheet i would like the above to have an affect like at present but the cell in column D will have no affect and stay yellow.
Now on another code that i use i will be allowing this cell in column D to sometimes be pink or it will stay yellow.
This is just for your reference so its not a fixed yellow if you see what i mean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "I"


'   *** Specify start row ***
    myStartRow = 8
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row + 1
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Highlight the row and column that contain the active cell
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
    Target.Interior.Color = vbGreen
    Application.ScreenUpdating = True


End Sub

 

[pbornemeier]

I believe this does what you asked:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range
    Dim rngCell As Range

    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "I"

'   *** Specify start row ***
    myStartRow = 8
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row + 1
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Highlight the row and column that contain the active cell
    For Each rngCell In Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol))
        If rngCell.Column <> 4 Then rngCell.Interior.ColorIndex = 8
    Next
    If Target.Column <> 4 Then Target.Interior.Color = vbGreen
    Application.ScreenUpdating = True

End Sub

 

[pbornemeier]

This is a bit faster:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range
    Dim lPrevColor As Long


    If Target.Cells.Count > 1 Then Exit Sub
    
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "I"


'   *** Specify start row ***
    myStartRow = 8
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row + 1
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
    'Save initial color of column D of target row
    lPrevColor = Intersect(Rows(Target.Row), Me.Columns(4)).Cells.Interior.Color
    
'   Highlight the row and column that contain the active cell
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
    Target.Interior.Color = vbGreen
    
    'Change column D of target row back to original color
    Intersect(Rows(Target.Row), Columns(4)).Interior.Color = lPrevColor

    Application.ScreenUpdating = True

End Sub