Highlight current row & column revisited

[RonMcK]

Hi, All,

I want to highlight the current row and column in a table. Searching the knowledge base I found DRJ's Highlight Current Row and Column; I included its code below.

One drawback of this particular implementation is the it clears whatever color formatting one's worksheet already has.

So, question one is how difficult will it be to modify this code to capture the existing color attributes and reset them after the row and/or column changes?

In addition, I prefer that the entire row and column be highlighted, not just that part of the row to the left of the selected cell and above the selected cell.

Are these easily achievable?

[vba]Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim RngRow As Range
Dim RngCol As Range
Dim RngFinal As Range
Dim Row As Long
Dim Col As Long

Cells.Interior.ColorIndex = xlNone

Row = Target.Row
Col = Target.Column

Set RngRow = Range("A" & Row, Target)
Set RngCol = Range(Cells(1, Col), Target)
Set RngFinal = Union(RngRow, RngCol)

RngFinal.Interior.ColorIndex = 6

End Sub[/vba]

Thanks in advance for your advice and guidance.

[RonMcK]

Okay, I extended the highlighting of the row and the column. For proof of concept, I hardcoded MaxCol as 20 and MaxRow as 25 and modifed the code as follows:

[vba]Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim RngRow As Range
Dim RngCol As Range
Dim RngFinal As Range
Dim Row As Long
Dim Col As Long
Dim MaxRow As Long
Dim MaxCol As Long

MaxCol = 20
MaxRow = 25

Cells.Interior.ColorIndex = xlNone

Row = Target.Row
Col = Target.Column

Set RngRow = Range("A" & Row, "P" & Row)
Set RngCol = Range(Cells(1, Col), Cells(MaxRow, Col))

Set RngFinal = Union(RngRow, RngCol)

RngFinal.Interior.ColorIndex = 4 ' now green, was yellow

End Sub
[/vba]

The first requirement is going to be more challenging. I'm not sure how the row coloring by conditional formating affects the equation(s).

And, as I think about it, I'd like to use two pastel colors, one for the row and one for the column with 'addition' of the colors in the target cell.

Thanks,

[snb]

Or
[VBA]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With UsedRange
.Cells.Interior.ColorIndex = xlNone
.Rows(Target.Row).Interior.ColorIndex = 4
.Columns(Target.Column).Interior.ColorIndex = 4
End With
End Sub
[/VBA]

[Bob Phillips]

Why don't you take a different approach, don't use a colour but use an overlaid transparent bar?

[p45cal]

Why don't you take a different approach, don't use a colour but use an overlaid transparent bar?

Taking this further, try adding the following code to the sheet's code module:[VBA]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
blah
End Sub
[/VBA]Then in a standard code module have this macro:[VBA]Sub blah()
TheWidth = 4 'try adjusting this
FourShapesArr = Array("abv", "lft", "rgt", "blw")'(above,left,right,below)
For Each shp In FourShapesArr'this loop checks each rectangle exists and adds it if it doesn't.
Set zz = Nothing
On Error Resume Next
Set zz = ActiveSheet.Rectangles(shp)
On Error GoTo 0
If zz Is Nothing Then
Set yy = ActiveSheet.Rectangles.Add(1, 1, 1, 1)
With yy
.Name = shp
With .ShapeRange.Fill
.Visible = msoTrue
.Solid
.ForeColor.SchemeColor = 13
.Transparency = 0.5
End With
.ShapeRange.Line.Visible = msoFalse
End With
End If
Next shp
With ActiveSheet.Rectangles("abv")
.Top = 0
.Height = ActiveCell.Top
.Left = ActiveCell.Left + ActiveCell.Width / 2 - TheWidth / 2
.Width = TheWidth
End With
With ActiveSheet.Rectangles("lft")
.Top = ActiveCell.Top + ActiveCell.Height / 2 - TheWidth / 2 + 1
.Height = TheWidth
.Left = 0
.Width = ActiveCell.Left
End With
With ActiveSheet.Rectangles("rgt")
.Top = ActiveCell.Top + ActiveCell.Height / 2 - TheWidth / 2 + 1
.Height = TheWidth
.Left = ActiveCell.Left + ActiveCell.Width
.Width = Cells(ActiveCell.Row, Columns.Count).Left + Cells(ActiveCell.Row, Columns.Count).Width
End With
With ActiveSheet.Rectangles("blw")
.Top = ActiveCell.Top + ActiveCell.Height
.Height = Cells(Rows.Count, ActiveCell.Column).Top + Cells(Rows.Count, ActiveCell.Column).Height - .Top
.Left = ActiveCell.Left + ActiveCell.Width / 2 - TheWidth / 2
.Width = TheWidth
End With
End Sub
[/VBA]I've not highlighted the full width/height of the cells as this would have prevented cell selection of highlighted cells with the mouse (the overlaid rectangle ended up being selected instead).
Will this do?

[AMontes]

Try:
[vba]

Private Sub Worksheet_SelectionChange(ByVal Target As
Range)
Application.EnableEvents =
False
Union(Target.EntireRow,
Target.EntireColumn).Select
Intersect(Target.EntireRow, Target.EntireColumn).Activate
Application.EnableEvents =
True
End Sub

[/vba]

[RonMcK]

Thanks, snb, Bob, p45cal, and AMontes,

I'll look at these suggestions tonight and see what new questions I have for all y'all.

Thanks,

[Bob Phillips]

Ron,

You can also achieve it to show a highlight on mouseover, it doesn't have to be on selection.