Today, I'd like to take time out of my busy day and help Preet, who writes:
"How can I highlight the column and row of my current cell? If i am in cell J4 and want to highlight column J and row 4, what is the shortcut for it?"
As far as I know Preet, there is no 'Shortcut' to automatically highlight the active cell/column. If there is a way, I'm sure one of you won't hesitate to point it out, making me feel like a complete ass.
In any case, VBA is the solution I came up with:
Copy this code and paste it into the worksheet's 'SelectionChange' event. This procedure dynamically creates new conditional formatting rules that tell Excel to highlight the current row and column.
-
'Highlights the active row
-
With ActiveSheet.Cells
-
.FormatConditions.Delete
-
.FormatConditions.Add Type:=xlExpression, _
-
Formula1:="=ROW(A" & ActiveCell.Row & ") = " & ActiveCell.Row
-
.FormatConditions(1).Interior.ColorIndex = 36
-
End With
-
'Highlights the active column
-
With ActiveSheet.Cells
-
.FormatConditions.Add Type:=xlExpression, _
-
Formula1:="=column(" & Mid(Left(ActiveCell.Address, InStr(2, ActiveCell.Address, "$")-1), 2, 10) & "1) = " & ActiveCell.Column
-
.FormatConditions(2).Interior.ColorIndex = 36
-
End With
Once the code is in place, Excel will highlight the row and column for the cell that is active. This kind of effect can help when viewing or editing a large grid.
Of course, there are a couple of caveats.
First, when you highlight a range, don't expect the range's cross section to be highlighted. That requires some other mumbo-jumbo that I'm not prepared to tackle. Only the last activated cell will be affected.
Secondly, you'll notice the code clears all conditional formatting before doing its magic. This means that you should probably not use this on a sheet that already has conditional formatting.
That's it Preet. Now go tell everyone how awesome I am.
*******UPDATE********
Dan came up with an excellent alternative to coloring or conditional formatting the cells. In his procedure, Dan simply selects a range made up of the selected column and row. Fantastic.
-
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
-
Dim str As String
-
On Error Resume Next
-
With Target
-
If .Count = 1 Then
-
str = .Address & "," & .Row & ":" & .Row _
-
& "," & Left(.Address, InStr(2, .Address, "$") - 1) & ":" _
-
& Left(.Address, InStr(2, .Address, "$") - 1)
-
End If
-
End With
-
Range(str).Select
-
On Error GoTo 0
-
End Sub
RELATED STUFF
It's actually a lot easier than that.
Ctrl+spacebar will select the column and shift+spacebar will select the row.
for an impressive list of shortcuts: http://office.microsoft.com/en-us/excel/HP052037811033.aspx
@Jayson
Yeah, but if you try to do both, it selects the entire set of data or the entire worksheet.
Jayson: Thanks for the link. I don't think you can highlight both row and column at the same time. That is why I assumed Preet wanted to color the row and column - not simpy activate them.
didn't see that... hmmm
This seems to work like the initial code, but avoids stomping all over previous Conditional Formatting:
At the top of each sheet's code module:
Private sPrevRow As String
Private sPrevCol As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sTarAddr As String
Dim sRow As String
Dim sCol As String
If sPrevRow "" Then
Range(sPrevCol & ":" & sPrevCol).Interior.ColorIndex = -4142
Range(sPrevRow & ":" & sPrevRow).Interior.ColorIndex = -4142
End If
' On Error Resume Next
If Target.Cells.Count > 1 Then Set Target = Target.Cells(1)
If Err 0 Then Exit Sub
sTarAddr = Target.Address(0, 0)
sRow = CStr(Target.Row)
sCol = Left$(sTarAddr, Len(sTarAddr) - Len(sRow))
Range(sCol & ":" & sCol).Interior.ColorIndex = 34
Range(sRow & ":" & sRow).Interior.ColorIndex = 34
sPrevCol = sCol
sPrevRow = sRow
End Sub
I had to throw in the On Error Resume Next because clicking on the 'A zero cell' to select the whole worksheet gave me an overflow error on Target.Cells.Count
Oops - remove the comment character from the
' On Error Resume Next
line - was testing and forgot to clear that...
JamesCox: Valiant effort. But it does seem that your approach stomps on any existing interior cell formatting.
I think the lesser of two evils is the condtional formatting approach.
DataPig,
Love the blog. Keep up the great work!
Not necessarily to argue with you (but it does drive your blog's stats up!) - which is easier to re-do: setting up Conditional Formatting or clicking on a cell and changing the fill color? Also, since it wipes out the Conditional Formatting of cells whose Conditional Formatting hadn't caused a change in the default cell or text color, it's less obvious that those have been deleted than is a cell color change.
Of course, which is the lesser evil probably depends more on which (Conditional Formatting or cell color) the OP uses the most...
See also Chip Pearson's Add-in RowLiner
http://www.cpearson.com/excel/RowLiner.htm
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.ClearFormats
With Target
.EntireRow.Interior.ColorIndex = 36
.EntireColumn.Interior.ColorIndex = 36
End With
End Sub
Mike,
Thanks! This is what I was looking for. I was wrong about the short-cut.
MIKE - TRY THIS MATE...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String
On Error Resume Next
With Target
If .Count = 1 Then
str = .Address & "," & .Row & ":" & .Row _
& "," & Left(.Address, InStr(2, .Address, "$") - 1) & ":" _
& Left(.Address, InStr(2, .Address, "$") - 1)
End If
End With
Range(str).Select
On Error GoTo 0
End Sub
Dan: This is fantastic! This is definitely better than my method. I've added an update to the post.
Great, Dan!
A marvelous example of giving the OP what he wanted, not what he asked for .
DAN guru,
Tussi great ho (you are great),
Your July8 post is great. It does not affect the existing cell colours.
I have been looking for this for years, and think that your code should be a standard feature in all future spreadsheet software.
I am just yet a power-user, on learning curve to VBA.
Kindly help me for
1) how to make it available to all sheet.
2) how to make it like an add-in with switch on/off type
I have used RowLiner (http://www.cpearson.com/excel/RowLiner.htm) and Andrew's cell spotter, but you code is great
Thanking you in advance
xcel_star, India
Yeah this is possible... It will require programming the VBE though. I'll give Mike a shout when I've managed it - see if he wants to provide a link or something.
Hi Mike,
Very cool blog
FYI, I've done some similar stuff before using the CELL function. Note Undo is not affected.
http://blog.livedoor.jp/andrewe/archives/17936306.html
http://blog.livedoor.jp/andrewe/archives/50061563.html
Only way i can figure is to programme the VBE (I tool the code from Chip Pearson - http://www.cpearson.com). If anyone knows of a simplier way let me know. Run SelectRowCol procedure to enable row/col highlight and again to turn it off.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Names("Selection").Delete
DeleteProcedureFromModule
End Sub
Private Sub Workbook_Open()
ActiveWorkbook.Names.Add Name:="Selection", RefersToR1C1:="=0"
End Sub
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long
Sub CreateEventProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim wks As Worksheet
Application.ScreenUpdating = False
Application.VBE.MainWindow.Visible = False
Set VBProj = ActiveWorkbook.VBProject
For Each wks In Worksheets
Set VBComp = VBProj.VBComponents(wks.Name)
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CreateEventProc("SelectionChange", "Worksheet")
LineNum = LineNum + 1
.InsertLines LineNum, "Dim str As String"
LineNum = LineNum + 1
.InsertLines LineNum, "On Error Resume Next"
LineNum = LineNum + 1
.InsertLines LineNum, "With Target"
LineNum = LineNum + 1
.InsertLines LineNum, "If .Count = 1 Then"
LineNum = LineNum + 1
.InsertLines LineNum, "str = .Address &" & Chr(34) & "," & Chr(34) & "& .Row &" & Chr(34) & ":" & Chr(34) & " & .Row &" & Chr(34) & "," & Chr(34) & " & Left(.Address, InStr(2, .Address," & Chr(34) & "$" & Chr(34) & ") - 1) & " & Chr(34) & ":" & Chr(34) & " & Left(.Address, InStr(2, .Address, " & Chr(34) & "$" & Chr(34) & ") - 1)"
LineNum = LineNum + 1
.InsertLines LineNum, "End If"
LineNum = LineNum + 1
.InsertLines LineNum, "End With"
LineNum = LineNum + 1
.InsertLines LineNum, "Range(str).Select"
LineNum = LineNum + 1
.InsertLines LineNum, "On Error GoTo 0"
End With
Next wks
End Sub
Sub DeleteProcedureFromModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim NumLines As Long
Dim ProcName As String
Dim wks As Worksheet
Set VBProj = ActiveWorkbook.VBProject
On Error Resume Next
For Each wks In Worksheets
Set VBComp = VBProj.VBComponents(wks.Name)
Set CodeMod = VBComp.CodeModule
ProcName = "Worksheet_SelectionChange"
With CodeMod
StartLine = .ProcStartLine(ProcName, vbext_pk_Proc)
NumLines = .ProcCountLines(ProcName, vbext_pk_Proc)
.DeleteLines StartLine:=StartLine, Count:=NumLines
End With
Next wks
On Error GoTo 0
End Sub
Sub EliminateScreenFlicker()
Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.ScreenUpdating = False
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If
CreateEventProcedure
Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub
Sub SelectRowCol()
Dim S As String
S = ThisWorkbook.Names("Selection").RefersTo
S = Mid(S, 2)
If S = "1" Then
Call DeleteProcedureFromModule
ActiveWorkbook.Names.Add Name:="Selection", RefersToR1C1:="=0"
Else
Call EliminateScreenFlicker
ActiveWorkbook.Names.Add Name:="Selection", RefersToR1C1:="=1"
End If
End Sub
Hi Dan,
I paste your last code to excel, but when executed it said "Compile error : Only comments may appear after End Sub, End Function, or End Property. "
How to fix it?
Fyi, it stops here:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Please advice. Thank you.
To get the row & column select thin to work in ANY worksheet put the following event procedure in the ThisWorkbook code module:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim str As String
On Error Resume Next
With Target
If .Count = 1 Then
str = .Address & "," & .Row & ":" & .Row _
& "," & Left(.Address, InStr(2, .Address, "$") - 1) & ":" _
& Left(.Address, InStr(2, .Address, "$") - 1)
End If
End With
Sh.Range(str).Select
On Error GoTo 0
End Sub
This should do the same thing as Dan's code posted on July 8, 2009...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Union(Target.EntireColumn, Target.EntireRow).Select
Target.Activate
End Sub
If you would want this code in the SelectionChange event, then you would need to add the test for Target.Count>1 and surround the code with Application.EnableEvents=False and Application.EnableEvents=True to stop the code from selecting everything.
Rick: Very nice!
Thanks datapig, I'm glad you liked it. Too bad I didn't find your website sooner because then other readers here would have had a better chance of seeing it (while the topic was "fresh"). For those interested (mainly so you can just copy/paste it), here is the SelectionChange event version of my code (this duplicates the functionality of Dan's code that you posted in the Update to your blog)...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Union(Target.EntireColumn, Target.EntireRow).Select
Target.Activate
Application.EnableEvents = True
End Sub
Now, brace yourself, because I think you are going to **really** be surprised by this next piece of code. Here is a **very short** SelectionChange event procedure that duplicates (the best I can tell) the functionality of your blog's originally posted code (turning the active cell's row and column yellow)...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 0
Union(Target.EntireColumn, Target.EntireRow).Interior.ColorIndex = 36
End Sub
Actually, on the last code I posted (the one that makes the active cell's row and column yellow), there is one major difference from your originally posted code... if you select a range of cells, then my code makes all the rows and all the columns associated with the range become highlighted whereas your code only highlights the active cell (within the range)'s row and column.
the Ctrl+C or copy command does not work if the highlight function is active. is there any way to fix it?
Here is the "simplified" SelectionChange event version (this duplicates the functionality of Dan's code that you posted in the Update to your blog)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str$
On Error Resume Next
With Target
str = _
IIf(.Count = 1, _
.Address & "," & .EntireRow.Address & "," & .EntireColumn.Address, _
Target.Address)
End With
Range(str).Select
On Error GoTo 0
End Sub
PS: I've just read Rick Rothstein's solution
('http://datapigtechnologies.com/blog/index.php/highlighting-the-active-row-and-column/comment-page-1/#comment-2402') after I write my answer.
Sorry for that (and for my english because I'm a french guy and my english speaking is weak)
Very late to the party, but another way.
Select all of the cells in the target area and add CF with a formula of
=OR(ROW()=CELL("row"),COLUMN()=CELL("col"))
and the colour of your choice.
Then add event code of
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = True
End Sub
Alternatively,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Local Error Resume Next
With Target
If .Count = 1 Then
With .Cells
s = .Address & "," & .EntireColumn.Address & "," & .EntireRow.Address
Range(s).Select
End With
End If
End With
On Local Error GoTo 0
End Sub