Highlight Row and Column on cell selection

EBoudreau

Board Regular
Joined
Aug 21, 2015
Messages
137
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:
VBA Code:
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:
VBA Code:
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
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
VBA Code:
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

Board Regular
Joined
Aug 21, 2015
Messages
137
VBA Code:
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.

VBA Code:
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
 

Attachments

  • Runtime Error.PNG
    Runtime Error.PNG
    174.2 KB · Views: 2

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
On wich line? (Click on Debug and send yellow line)
 

EBoudreau

Board Regular
Joined
Aug 21, 2015
Messages
137

ADVERTISEMENT

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.
 

Attachments

  • Debug Screenshot.PNG
    Debug Screenshot.PNG
    83 KB · Views: 5

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
Is your sheet protected?
 

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
You had to unprotect the sheet before this line: RngCol(Target.Row - 8).Value = "<-"
 

EBoudreau

Board Regular
Joined
Aug 21, 2015
Messages
137
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,804
Messages
5,638,455
Members
417,025
Latest member
MusterDuster

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top