Highlight Row and Column on cell selection

[EBoudreau]

In the following I have some code I need modified to see if I can do the following:

1) Only have this work when selecting a cell inside a couple sets of ranges.
Ranges are E9:DA56 and E59:DA106 where I would like it to be active.
2) Only highlight or outline the cells above the selected cell to a given row number, and to the left of the selected cell to a given column number.
So for Range E9:DA56 can it do so up through row 7 and to the left through column C?
For Range E59:DA106 can it do so up through row 57 and to the left through column C?
3) The code currently replaces all the formatting to in the sheet so none of my cell formatting stays as soon as I click on a cell. I would like it to just highlight or outline as indicated in item 1 and then when I click on another cell, everything returns to how it was.
4) Can I also make it so that Cells in range C9:C56 are the only ones that will allow formatting cells instead of the whole sheet? I tried it before in a previous edition of this file but it

Here's the code I was able to find to incorporate with my sheet.

Here's what was already in there:

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim rng As Range
    
    Application.EnableEvents = False
    ActiveSheet.Unprotect Password:="WellingtonFrac"
    
    Set rng = Intersect(Target, Range("A9:A20, A22:A34, A59:A61, E9:DA56, E59:DA82"))
    If Not rng Is Nothing Then Call Capitalise(rng)
        
    Set rng = Intersect(Target, Range("D53:D1583"))
    If Not rng Is Nothing Then Call ConvertToTime(rng)
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, Password:="WellingtonFrac"
    Application.EnableEvents = True

    Sheets("Frac Report").EnableSelection = xlNoRestrictions
    Sheets("Stage Times").EnableSelection = xlNoRestrictions

End Sub

Here's what I'm trying to add:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Cells.Interior.ColorIndex = xlColorIndexNone
 
 Target.EntireColumn.Interior.ColorIndex = 37
 Target.EntireRow.Interior.ColorIndex = 37
 Target.Interior.ColorIndex = xlColorIndexNone
 
End Sub

 

[EBoudreau]

reset the column: RngCol.Value=""
fill the cell: RngCol(Target.Row - 8).Value="<-"

Unless I'm mistaken, I do not see RngCol.Value="" anyhwere in the above code.

 

[mart37]

RngRow.Interior.ColorIndex = 37 'xlColorIndexNone
RngCol.Interior.ColorIndex = 37 'xlColorIndexNone
RngCol.Value=""
RngRow(Target.Column - 4).Interior.ColorIndex = 46
RngCol(Target.Row - 8).Interior.ColorIndex = 46
RngCol(Target.Row - 8).Value="<-"

 

[EBoudreau]

RngRow.Interior.ColorIndex = 37 'xlColorIndexNone
RngCol.Interior.ColorIndex = 37 'xlColorIndexNone
RngCol.Value=""
RngRow(Target.Column - 4).Interior.ColorIndex = 46
RngCol(Target.Row - 8).Interior.ColorIndex = 46
RngCol(Target.Row - 8).Value="<-"

I'm getting a runtime error.
Did I modify that correctly?
Here's what all is in my entire sheet code but the section we're dealing with is toward the bottom.

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim Rng As Range
    
    Application.EnableEvents = False
    ActiveSheet.Unprotect Password:="WellingtonFrac"
    
    Set Rng = Intersect(Target, Range("A9:A20, A22:A34, A59:A61, E9:DA56, E59:DA82"))
    If Not Rng Is Nothing Then Call Capitalise(Rng)
        
    Set Rng = Intersect(Target, Range("D53:D1583"))
    If Not Rng Is Nothing Then Call ConvertToTime(Rng)
    
'    I assume this is the range you want to automatically trigger the recorded macro. If not, change accordingly
'    If Not Intersect(Target, Range("C9:C32")) Is Nothing Then
'        Call CopyWellColors
'    End If
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, Password:="WellingtonFrac"
    Application.EnableEvents = True

    Sheets("Frac Report").EnableSelection = xlNoRestrictions
    Sheets("Stage Times").EnableSelection = xlNoRestrictions

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Rng As Range, RngRow As Range, RngCol As Range
Set Rng = Intersect(Target, Range("F9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    Set RngCol = Range("D9:D56")
    RngRow.Interior.ColorIndex = 37 'xlColorIndexNone
    RngCol.Interior.ColorIndex = 15 'xlColorIndexNone
    RngCol.Value = ""
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(Target.Row - 8).Interior.ColorIndex = 46
    RngCol(Target.Row - 8).Value = "<-"
End If
Set Rng = Intersect(Target, Range("F59:DA106"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E57:DA57")
    Set RngCol = Range("D59:D106")
    RngRow.Interior.ColorIndex = 37 'xlColorIndexNone
    RngCol.Interior.ColorIndex = 15 'xlColorIndexNone
    RngCol.Value = ""
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(Target.Row - 58).Interior.ColorIndex = 46
    RngCol(Target.Row - 58).Value = "<-"
End If
End Sub

 

[mart37]

On wich line? (Click on Debug and send yellow line)

 

[EBoudreau]

On wich line? (Click on Debug and send yellow line)

Screenshot attached. Sorry I don't have the XL2bb software. can only do screenshots and copy code at this point.

 

[mart37]

Is your sheet protected?

 

[EBoudreau]

Is your sheet protected?

Yes it is.
Here's a link to the file. It's too big of an area to create a mini sheet.

File Folder

 

[mart37]

You had to unprotect the sheet before this line: RngCol(Target.Row - 8).Value = "<-"

 

[EBoudreau]

I’ll put that in there and report back.

You had to unprotect the sheet before this line: RngCol(Target.Row - 8).Value = "<-“

 

[EBoudreau]

You had to unprotect the sheet before this line: RngCol(Target.Row - 8).Value = "<-"

That worked very well, but the "<-" is not going away when I click on a different cell in a different row. Is it possible to make the Text getting entered in go away when the cell goes back to its original color?