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
 
Sort by date Sort by votes
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 = 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
Click to expand...

I think I need to take a step back and not have the column change any colors. I would like to leave them alone. What do I need to comment out or adjust so only the rows change colors?
Sorry again, I just don't like how the columns are working. Its doing its job correctly but it's visual form isn't what I want after all. I think it would just look best if the rows above the two ranges highlight, and then revert back when unselected.
 
Upvote 0

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
What a job. Single cells have no problems but you use combined cells.
Don't forget to select a cell outside the area as you save the workbook. The last color will not be saved as the cursor stays in the area!

VBA Code: 
Public OldColor As Integer
Public OldCell As Range

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")
    Else
        Set Rng = Intersect(Target, Range("E59:DA106"))
        If Not Rng Is Nothing Then
            Set RngRow = Range("E57:DA57")
            Set RngCol = Range("C59:C106")
        End If
    End If
    If Rng Is Nothing Then GoTo exitsub
    RngRow.Interior.ColorIndex = 37
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    If OldColor <> 0 Then
        If Target.Row = OldCell.Row Then GoTo exitsub
        If Target.Row Mod 2 = 0 And Target.Row = OldCell.Row + 1 Then GoTo exitsub
        If Target.Row Mod 2 = 1 And Target.Row + 1 = OldCell.Row Then GoTo exitsub
        OldCell.Interior.ColorIndex = OldColor
        Range("C" & IIf(OldCell.Row Mod 2 = 0, OldCell.Row - 1, OldCell.Row + 1)).Interior.ColorIndex = OldColor
    End If
    Set OldCell = Range("C" & Target.Row)
    OldColor = Range("C" & Target.Row).Interior.ColorIndex
    Range("C" & Target.Row).Interior.ColorIndex = 37
    Range("C" & IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row + 1)).Interior.ColorIndex = 37
exitsub:
    Set Rng = Nothing
End Sub
 
Upvote 0
Sorry Also a click ouside the area does not save the last color.
 
Upvote 0
This version works beter, I think.
VBA Code: 
Public OldColor As Integer
Public OldCell As Range

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")
    Else
        Set Rng = Intersect(Target, Range("E59:DA106"))
        If Not Rng Is Nothing Then
            Set RngRow = Range("E57:DA57")
            Set RngCol = Range("C59:C106")
        End If
    End If
    If Rng Is Nothing Then
        If OldColor <> 0 Then
            OldCell.Interior.ColorIndex = OldColor
            Range("C" & IIf(OldCell.Row Mod 2 = 0, OldCell.Row - 1, OldCell.Row + 1)).Interior.ColorIndex = OldColor
            OldColor = 0
            Set OldCell = Nothing
        End If
        GoTo exitsub
    End If
    RngRow.Interior.ColorIndex = 37
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    If OldColor <> 0 Then
        If Target.Row = OldCell.Row Then GoTo exitsub
        If Target.Row Mod 2 = 0 And Target.Row = OldCell.Row + 1 Then GoTo exitsub
        If Target.Row Mod 2 = 1 And Target.Row + 1 = OldCell.Row Then GoTo exitsub
        OldCell.Interior.ColorIndex = OldColor
        Range("C" & IIf(OldCell.Row Mod 2 = 0, OldCell.Row - 1, OldCell.Row + 1)).Interior.ColorIndex = OldColor
    End If
    Set OldCell = Range("C" & Target.Row)
    OldColor = Range("C" & Target.Row).Interior.ColorIndex
    Range("C" & Target.Row).Interior.ColorIndex = 37
    Range("C" & IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row + 1)).Interior.ColorIndex = 37
exitsub:
    Set Rng = Nothing
End Sub
 
Upvote 0
mart37 said:
What a job. Single cells have no problems but you use combined cells.
Don't forget to select a cell outside the area as you save the workbook. The last color will not be saved as the cursor stays in the area!

VBA Code: 
Public OldColor As Integer
Public OldCell As Range

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")
    Else
        Set Rng = Intersect(Target, Range("E59:DA106"))
        If Not Rng Is Nothing Then
            Set RngRow = Range("E57:DA57")
            Set RngCol = Range("C59:C106")
        End If
    End If
    If Rng Is Nothing Then GoTo exitsub
    RngRow.Interior.ColorIndex = 37
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    If OldColor <> 0 Then
        If Target.Row = OldCell.Row Then GoTo exitsub
        If Target.Row Mod 2 = 0 And Target.Row = OldCell.Row + 1 Then GoTo exitsub
        If Target.Row Mod 2 = 1 And Target.Row + 1 = OldCell.Row Then GoTo exitsub
        OldCell.Interior.ColorIndex = OldColor
        Range("C" & IIf(OldCell.Row Mod 2 = 0, OldCell.Row - 1, OldCell.Row + 1)).Interior.ColorIndex = OldColor
    End If
    Set OldCell = Range("C" & Target.Row)
    OldColor = Range("C" & Target.Row).Interior.ColorIndex
    Range("C" & Target.Row).Interior.ColorIndex = 37
    Range("C" & IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row + 1)).Interior.ColorIndex = 37
exitsub:
    Set Rng = Nothing
End Sub
Click to expand...

It sure is quite a job!. Thank you for your help.
Are the cells in the column being merged creating the problem with the colors not going back to normal? They're staying the new color and not reverting back to the previous color when clicking anywhere else in the ranges specified or outside the range entirely.
The rows are working perfectly as they do revert back when another cell in the ranges are clicked.

All this is more for convenience and aesthetics rather than a necessity. Really for ease of navigating the form.
 
Upvote 0
In the second last version the column color must reverse back when clicking in the ranges specified.
In the last version also when you click outside the ranges specified.
 
Upvote 0
mart37 said:
In the second last version the column color must reverse back when clicking in the ranges specified.
In the last version also when you click outside the ranges specified
Click to expand...

For some reason neither one are allowing the color in the column cells for both ranges to go back to old color.
And as I think about it and confirm with some colleagues, I think I want to only have the two rows E7:DA7 and E57:DA57 have the changing colors as I click throughout the ranges. Because I have to have the column colors be transferred to other cells in the sheet and to another sheet. For safety reasons in the industry I work in, I don't think I want temporarily highlighted colors to be copied when someone clicks on the macro button to copy colors in those column ranges to other cells. Those cell colors are for specific oil and gas well identifiers so I'm going to keep them from changing.

What I'm running into now is cell A7:B7 is turning orange. I would like it to remain the original color and be untouched when I click on a cell inside the E9:DA56. (Screenshot attached)
Everything else looks to be working fine.

Here's the code for the sheet which also leads to a final question I have at the bottom of this post:
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("E9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    'Set RngCol = Range("C9:C56")
    RngRow.Interior.ColorIndex = 37 'xlColorIndexNone
    'RngCol.Interior.ColorIndex = 46 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    '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 = 37 'xlColorIndexNone
    'RngCol.Interior.ColorIndex = 46 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    'RngCol(Target.Row - 58).Interior.ColorIndex = 37
End If
End Sub

I commented out the column formatting as I would like them to remain unchanged. But that one cell is changing color.

Also, how would you make it so that Cells C9:C56 are the only cells formattable? I don't want users to be able to edit the color of any other cells but those. Is that doable?
RIght now I have "AllowFormattingCells=True" but that makes it so I can edit colors of cells all over the page.
 

Attachments

  • A7 Color Change.PNG
    A7 Color Change.PNG
    114.1 KB · Views: 10
Upvote 0
EBoudreau said:
For some reason neither one are allowing the color in the column cells for both ranges to go back to old color.
And as I think about it and confirm with some colleagues, I think I want to only have the two rows E7:DA7 and E57:DA57 have the changing colors as I click throughout the ranges. Because I have to have the column colors be transferred to other cells in the sheet and to another sheet. For safety reasons in the industry I work in, I don't think I want temporarily highlighted colors to be copied when someone clicks on the macro button to copy colors in those column ranges to other cells. Those cell colors are for specific oil and gas well identifiers so I'm going to keep them from changing.

What I'm running into now is cell A7:B7 is turning orange. I would like it to remain the original color and be untouched when I click on a cell inside the E9:DA56. (Screenshot attached)
Everything else looks to be working fine.

Here's the code for the sheet which also leads to a final question I have at the bottom of this post:
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("E9:DA56"))
If Not Rng Is Nothing Then
    Set RngRow = Range("E7:DA7")
    'Set RngCol = Range("C9:C56")
    RngRow.Interior.ColorIndex = 37 'xlColorIndexNone
    'RngCol.Interior.ColorIndex = 46 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    '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 = 37 'xlColorIndexNone
    'RngCol.Interior.ColorIndex = 46 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    'RngCol(Target.Row - 58).Interior.ColorIndex = 37
End If
End Sub

I commented out the column formatting as I would like them to remain unchanged. But that one cell is changing color.

Also, how would you make it so that Cells C9:C56 are the only cells formattable? I don't want users to be able to edit the color of any other cells but those. Is that doable?
RIght now I have "AllowFormattingCells=True" but that makes it so I can edit colors of cells all over the page.
Click to expand...

Well its interesting. I just changed the color of the of the A7:B7 cell back to blue manually and now it's not highlighting as desired. Not sure why I did that but I do however need to be able to restrict cell formatting to only be able to format those specified in my previous post.

ALso retaining the ability to hide rows and columns.
 
Upvote 0
mart37 said:
This version works beter, I think.
VBA Code: 
Public OldColor As Integer
Public OldCell As Range

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")
    Else
        Set Rng = Intersect(Target, Range("E59:DA106"))
        If Not Rng Is Nothing Then
            Set RngRow = Range("E57:DA57")
            Set RngCol = Range("C59:C106")
        End If
    End If
    If Rng Is Nothing Then
        If OldColor <> 0 Then
            OldCell.Interior.ColorIndex = OldColor
            Range("C" & IIf(OldCell.Row Mod 2 = 0, OldCell.Row - 1, OldCell.Row + 1)).Interior.ColorIndex = OldColor
            OldColor = 0
            Set OldCell = Nothing
        End If
        GoTo exitsub
    End If
    RngRow.Interior.ColorIndex = 37
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    If OldColor <> 0 Then
        If Target.Row = OldCell.Row Then GoTo exitsub
        If Target.Row Mod 2 = 0 And Target.Row = OldCell.Row + 1 Then GoTo exitsub
        If Target.Row Mod 2 = 1 And Target.Row + 1 = OldCell.Row Then GoTo exitsub
        OldCell.Interior.ColorIndex = OldColor
        Range("C" & IIf(OldCell.Row Mod 2 = 0, OldCell.Row - 1, OldCell.Row + 1)).Interior.ColorIndex = OldColor
    End If
    Set OldCell = Range("C" & Target.Row)
    OldColor = Range("C" & Target.Row).Interior.ColorIndex
    Range("C" & Target.Row).Interior.ColorIndex = 37
    Range("C" & IIf(Target.Row Mod 2 = 0, Target.Row - 1, Target.Row + 1)).Interior.ColorIndex = 37
exitsub:
    Set Rng = Nothing
End Sub
Click to expand...
So, I went back to a previous post to look at some previous attempts to do the formatting. I added a new column D to have the column cells do color changing. New Code below and Screenshot attached. I think this fixed my problem.

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 = 37 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(Target.Row - 8).Interior.ColorIndex = 46
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 = 37 'xlColorIndexNone
    RngRow(Target.Column - 4).Interior.ColorIndex = 46
    RngCol(Target.Row - 58).Interior.ColorIndex = 46
End If
End Sub

I Would like to add "<-" in the cells in the column that is only visible when it's highlighted the orange color. That way the highlighted cell in column D effectively points to the corresponding cell in column C I want to draw attention to. How would I write that in?
 

Attachments

  • Fixed Color Highlighting.PNG
    Fixed Color Highlighting.PNG
    87.2 KB · Views: 8
Upvote 0
reset the column: RngCol.Value=""
fill the cell: RngCol(Target.Row - 8).Value="<-"
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Solved
Highlighting selected words in a column.
Replies
6
Views
128
Akuini
Akuini
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
260
Gajendran Yadhav
G
A
  • Question
VBA Highlight cell if contains specific text
Replies
4
Views
115
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
167
Georgiboy
Georgiboy

Forum statistics

Threads
1,214,634
Messages
6,120,659
Members
448,975
Latest member
sweeberry

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