Highlight Row and Column on cell selection

E

EBoudreau

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

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, RngRow As Range, RngCol As Range
Set Rng = Intersect(Target, Range("E9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    Set RngCol = Range("C9:C56")
    RngRow.Interior.ColorIndex = xlColorIndexNone
    RngCol.Interior.ColorIndex = xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 37
    RngCol(Target.Row - 8).Interior.ColorIndex = 37
End If
Set Rng = Intersect(Target, Range("E59:DA106"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E57:DA57")
    Set RngCol = Range("C59:C106")
    RngRow.Interior.ColorIndex = xlColorIndexNone
    RngCol.Interior.ColorIndex = xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 37
    RngCol(Target.Row - 58).Interior.ColorIndex = 37
End If
End Sub
 
Upvote 0
mart37 said:
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, RngRow As Range, RngCol As Range
Set Rng = Intersect(Target, Range("E9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    Set RngCol = Range("C9:C56")
    RngRow.Interior.ColorIndex = xlColorIndexNone
    RngCol.Interior.ColorIndex = xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 37
    RngCol(Target.Row - 8).Interior.ColorIndex = 37
End If
Set Rng = Intersect(Target, Range("E59:DA106"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E57:DA57")
    Set RngCol = Range("C59:C106")
    RngRow.Interior.ColorIndex = xlColorIndexNone
    RngCol.Interior.ColorIndex = xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 37
    RngCol(Target.Row - 58).Interior.ColorIndex = 37
End If
End Sub
Click to expand...
Thank you! That worked with the exception to Rows E7:DA7 and E57:DA57 formatting is getting cleared but the highlighting is working. How can I make it so those rows stay the original color and revert after unselecting a cell in the ranges specified?

Also,
Column C is doing the same thing where the colors are gettin cleared.

Each cell in column C that I would like to highlight are two cells merged, which are in line with two rows each within the range. screenshots included.

Is it possible to make the highlighting revert to original color when cell within ranges are unselected?
 

Attachments

  • Good Column Highlighting.PNG
    Good Column Highlighting.PNG
    131.8 KB · Views: 21
  • Missing Column Highlighting.PNG
    Missing Column Highlighting.PNG
    134.4 KB · Views: 22
Upvote 0
RngCol(IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row) - 8).Interior.ColorIndex = 37
Replace: RngRow.Interior.ColorIndex = xlColorIndexNone with color number you want.
 
Upvote 0
mart37 said:
RngCol(IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row) - 8).Interior.ColorIndex = 37
Replace: RngRow.Interior.ColorIndex = xlColorIndexNone with color number you want.
Click to expand...
I tried that and get a compile error type mismatch. (Screenshot attached)
I might have fat fingered something.

Here's the resulting code I have.
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, RngRow As Range, RngCol As Range
Set Rng = Intersect(Target, Range("E9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    Set RngCol = Range("C9:C56")
    RngRow.Interior.ColorIndex = XlColorIndex = 37
    RngCol.Interior.ColorIndex = XlColorIndex = 46
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row) - 8).Interior.ColorIndex = 37
End If
Set Rng = Intersect(Target, Range("E59:DA106"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E57:DA57")
    Set RngCol = Range("C59:C106")
    RngRow.Interior.ColorIndex = XlColorIndex = 37
    RngCol.Interior.ColorIndex = XlColorIndex = 46
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row) - 8).Interior.ColorIndex = 37
End If
End Sub
 

Attachments

  • Compile Error- Type Mismatch.PNG
    Compile Error- Type Mismatch.PNG
    90.4 KB · Views: 14
Upvote 0
mart37 said:
RngRow.Interior.ColorIndex =46
Click to expand...
That doesn't seem to be fixing the problem. It currently sits as:
VBA Code: 
RngRow.Interior.ColorIndex = XlColorIndex = 46

When I make it:
VBA Code: 
RngRow.Interior.ColorIndex =46
I get a syntax error.
 
Upvote 0
Wait, maybe it does work but the column in both ranges do not revert back to previous color. The unique thing about the column C in both ranges is that we adjust the color based on what color the well heads are painted and then i click a button to run a macro that copies the formatting from C9:C56 down to C59:C106. Currently it's just changing the entire column to orange color number 46. The row is working and reverting to the original color, but the column range converts entirely to orange 46, and the cell matching the clicked cell is showing blue. I might have messed something up. I would like that column cell to highlight orange and then when the cell in the range is deselected, to revert back to the color it was before, which wont necessarily be the same color as it is now.

If that's not possible, I may have to change it back to where only the row highlights when cells in the ranges are selected if the column formatting will conflict.

Updated Code:
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, RngRow As Range, RngCol As Range
Set Rng = Intersect(Target, Range("E9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    Set RngCol = Range("C9:C56")
    RngRow.Interior.ColorIndex = 37
    RngCol.Interior.ColorIndex = 46
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row) - 8).Interior.ColorIndex = 37
End If
Set Rng = Intersect(Target, Range("E59:DA106"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E57:DA57")
    Set RngCol = Range("C59:C106")
    RngRow.Interior.ColorIndex = 37
    RngCol.Interior.ColorIndex = 46
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row) - 8).Interior.ColorIndex = 37
End If
End Sub

Forgive me as I stumble through this.
 

Attachments

  • Column Color changing backwards.PNG
    Column Color changing backwards.PNG
    83.1 KB · Views: 18
Upvote 0
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range, RngRow As Range, RngCol As Range
Set Rng = Intersect(Target, Range("E9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    Set RngCol = Range("C9:C56")
    RngRow.Interior.ColorIndex = 46 'xlColorIndexNone
    RngCol.Interior.ColorIndex = 46 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 37
    RngCol(Target.Row - 8).Interior.ColorIndex = 37
End If
Set Rng = Intersect(Target, Range("E59:DA106"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E57:DA57")
    Set RngCol = Range("C59:C106")
    RngRow.Interior.ColorIndex = 46 'xlColorIndexNone
    RngCol.Interior.ColorIndex = 46 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 37
    RngCol(Target.Row - 58).Interior.ColorIndex = 37
End If
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

Y
  • Solved
Highlighting selected words in a column.
Replies
6
Views
127
Akuini
Akuini
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
259
Gajendran Yadhav
G
A
  • Question
VBA Highlight cell if contains specific text
Replies
4
Views
114
DanteAmor
DanteAmor
Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
193
bobsan42
bobsan42
G
  • Question
Macro Code Help for multiple worksheets.
Replies
1
Views
166
Georgiboy
Georgiboy

Forum statistics

Threads
1,214,601
Messages
6,120,462
Members
448,965
Latest member
grijken

Share this page

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
Back
Top