PDA

View Full Version : [SOLVED] Highlight rows and column when a cell is selected



U_Shrestha
02-20-2008, 01:12 PM
Hello all,

I have a large table in Excel 2003, and when a cell from the table is selected, I would like to highlight the corresponding border of the rows and columns with red color. The cells in the table displays color using conditional formatting , therefore, I do not want the new code to change any existing color. I just want the border of the corresponding rows and color to be changed to thick red border. Can someone please help. Thanks.

Bob Phillips
02-20-2008, 03:23 PM
Best check out Chip's Rowliner http://www.cpearson.com/excel/RowLiner.htm

mdmackillop
02-20-2008, 04:50 PM
or


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Borders.LineStyle = xlNone
With Target.EntireColumn.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 3
.Weight = xlMedium
End With
With Target.EntireColumn.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 3
.Weight = xlMedium
End With
With Target.EntireRow.Borders(xlTop)
.LineStyle = xlContinuous
.ColorIndex = 3
.Weight = xlMedium
End With
With Target.EntireRow.Borders(xlBottom)
.LineStyle = xlContinuous
.ColorIndex = 3
.Weight = xlMedium
End With
End Sub

lucas
02-20-2008, 06:58 PM
I like that formatting Malcolm......much better than just shading.

U_Shrestha
02-21-2008, 06:43 AM
mdmackillop: The code that you sent is amazing. Thank you very much.
Thanks to xld also for the feedback. I am going to go for VB.

I think this is a very nice forum. cheers!! :)

U_Shrestha
02-21-2008, 09:57 AM
I noticed something. When I click on an existing table, the corresponding row and column of the selected cell gets highlight but it erases the border of the cell and doesn't allow other macros to run.

Can this code be modified in such a way that it does not change any existing format or interfere with any existing macros in the worksheet? Thanks.

Bob Phillips
02-21-2008, 10:07 AM
Not with event code, but Chip's rowliner doesn't have this problem as it overlays a shape on the worksheet.

U_Shrestha
02-21-2008, 10:15 AM
My workbook is saved in a public drive and will be opened from several PCs. To utilize row liner feature, does each PCs has be to installed with the Chip's rowliner or not. If yes, then my clients would not be able to utilize this feature. Thanks.

Bob Phillips
02-21-2008, 11:01 AM
This is a bit rough and ready, and it is not as good as Chip's addin, but it uses the same principle.



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape
With Me
On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 1000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 1000, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)
End With
End Sub

Private Sub FormatBlock(ByRef Block As Object)
With Block
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 47
.Fill.Transparency = 0.5
.Line.Weight = 0.5
.Line.DashStyle = msoLineSquareDot
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 47
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
End Sub

lucas
02-21-2008, 11:12 AM
another useful highlighter Bob.....

U_Shrestha
02-21-2008, 12:01 PM
xld: Your code is amazing. Instead of shading the entire row and column of the selected cell with pink color, can it only create a thick red border on the corresponding row and column of the cell, so that it does not affect the existing cell colors in the worksheet? Thanks.

mdmackillop
02-21-2008, 12:15 PM
As XLD has done all the hard work!


Private Sub FormatBlock(ByRef Block As Object)
With Block
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 1
.Fill.Transparency = 1
.Line.Weight = 2
'.Line.DashStyle = msoLineSquareDot
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 2 '47
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
End Sub

U_Shrestha
02-21-2008, 12:23 PM
Perfect!!! This is really awesome :)

Thank you very much, both xld and mdmackillop (http://www.vbaexpress.com/forum/member.php?u=87)

Bob Phillips
02-21-2008, 12:25 PM
It is a technique that I used in an addin I wrote about 4 years ago, so it was relatively easy.

Bob Phillips
02-21-2008, 12:32 PM
xld: Your code is amazing. Instead of shading the entire row and column of the selected cell with pink color, can it only create a thick red border on the corresponding row and column of the cell, so that it does not affect the existing cell colors in the worksheet? Thanks.

It won't affect existing colours, it is only an shape overlayed on the worksheet after all. It might make the colours on the inferior layer look a tad washed out but that is it. remember that you can increase the transparency, raising it from .5 to .8 will affect the look even less.

Bob Phillips
02-21-2008, 12:49 PM
Just noticed something else.

As I said it was a bit rough and ready, and it only goes as far as U75. To increase this change the 1000 in these two




Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 1000)

'and


Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 1000, rng.RowHeight)

U_Shrestha
02-21-2008, 01:21 PM
xld: Yeah, I just noticed that increasing the "1000" numbers extends its row and column length. Thanks so much. I hadn't noticed that before. This is an amazing code..

U_Shrestha
02-21-2008, 01:33 PM
One question though, i will be using this feature in a protected worksheet whose userinterface is set to True. I still notice the this feature does not work in a protected sheet. How can I use this feature in a protected sheet. The workbook always opens as locked as it is prepared for client who don't edit any data. Thanks.

Bob Phillips
02-21-2008, 01:36 PM
Is it password protected. If not, then just use



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape
With Me
Me.Unprotect
On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 5000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 5000, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)
Me.Protect
End With
End Sub

U_Shrestha
02-21-2008, 02:16 PM
It now works in a password protected sheet also. Thanks :)

I noticed that it does not allow a user to choose a cell that is highlighted with the border. For example, if I select E6 then I cannot select any cell in Column E and Row 6. Of course, I have to click somewhere else first and then click on the cell that is in Column E or Row 6.

Bob Phillips
02-21-2008, 02:22 PM
The reason for that is because of the shape overlaying the row and column, which stops you selecting the cells.

You can still arrow up/down/left/right to get to them.

U_Shrestha
02-21-2008, 02:40 PM
Oh, that is no problem at all. Thank you so much xld, you have responded to all of my questions today.

U_Shrestha
02-22-2008, 10:14 AM
Hello,

I was wondering if it is possible to assign this code to a command button so that a user may choose to enable or disable this feature by clicking at the button.

The reason for this is, as soon as I click any cell, the worksheet gets protected, so for the purpose of entering data, I would disable this feature, and when it is ready to be used by client I would enable this feature. Thanks.

Bob Phillips
02-22-2008, 10:48 AM
If you add a button from the contrl toolbox, this does it.



Private Highlighter As Boolean

Private Sub CommandButton1_Click()
Me.Unprotect
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Highlighter = Not Highlighter
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape

With Me

If Highlighter Then

Me.Unprotect
On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error GoTo 0

Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 5000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 5000, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)
Me.Protect
End If
End With
End Sub


But of course, best of all would be a facility that you can switch on/off per sheet or globally, and also set the colour.

U_Shrestha
02-22-2008, 11:05 AM
xld: Thank you once again. Your code works :)

U_Shrestha
04-29-2008, 02:02 PM
Hi again,

I am using following code to protect all the worksheets in my workbook.
Dim ws As Worksheet

For Each ws In Worksheets

ws.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True

Next ws I have following codes in WS module. My problem is, as soon as I click anywhere in the worksheet, it goes to unprotected mode but when I activate the Row And Column Highlighter, it does not unprotect it and works fine. How can I NOT unprotect the worksheet when I click on any cell in the worksheet area. Unless I call another macro to unprotect all the worksheets in the workbook, I don't want the sheet to go to unprotect mode. Can you please take a look again? Thanks.


Private Highlighter As Boolean

Private Sub CommandButton1_Click()
Me.Unprotect "password"
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Highlighter = Not Highlighter
Me.Protect "password"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape

With Me
Me.Unprotect "password"

If Highlighter Then

Me.Unprotect
On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error GoTo 0

Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 15000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 1650, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
End If
End With
End Sub

Private Sub FormatBlock(ByRef Block As Object)

With Block

.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 1
.Fill.Transparency = 1
.Line.Weight = 2
'.Line.DashStyle = msoLineSquareDot
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 2 '47
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
End Sub

Private Sub cmdShowForm_Click()
Call ShowMe
End Sub

Sub FormatCells()

Application.ScreenUpdating = False

Dim C As Range


For Each C In Range("l9:l509, n9:n509, r9:r509, t9:t509, v9:v509, x9:x509, z9:z509, ab9:ab509, ad9:ad509, af9:af509, ah9:ah509, aj9:aj509, al9:al509, am9:am509, an9:an509")


Select Case C.Value

Case Is = ""

C.Interior.ColorIndex = xlColorIndexNone
C.Font.ColorIndex = 1

Case Is <= Date

C.Interior.ColorIndex = 3
C.Font.ColorIndex = 2

Case Is < Date + 30

C.Interior.ColorIndex = 45
C.Font.ColorIndex = 1

Case Is < Date + 60

C.Interior.ColorIndex = 6
C.Font.ColorIndex = 1

Case Is < Date + 90

C.Interior.ColorIndex = 43
C.Font.ColorIndex = 1


Case Is > Date + 90

C.Interior.ColorIndex = xlColorIndexNone
C.Font.ColorIndex = 1

End Select

Next

Application.ScreenUpdating = True

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range, rgRow As Range
On Error GoTo ExitHere
Set rg = Range("L9:AO362")
If Intersect(rg, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rgRow In Intersect(Target, rg).Rows
Cells(rgRow.Row, "AP") = Date
Next rgRow
ExitHere:
Application.EnableEvents = True
End Sub

U_Shrestha
04-30-2008, 06:20 AM
I noticed that following toggle button code used to activate the cell-highlighter unprotects the sheet when the cell-highlighter is turned off. Can someone please edit the code so that it doesn't affect the worksheet protection. What I want is, the cell highlighter should work no matter whether the sheet is protected or not. thanks.
Private Sub CommandButton1_Click()
Me.Unprotect "password"
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Highlighter = Not Highlighter
End Sub