VBA Code to highlight the row and column of a selected cell

[ajgolfs]

I found some code that will highlight the row and column of a selected cell. However, I can't seem to get it to work. Are you able to get this macro to work, or do you have one simpler? Also, I already have a Worskheet selection change seen below. How do I incorporate that as well?

Highlight Cell VBA:



Option Explicit
'// Placed in the ThisWorkbook Object
Private Sub Workbook_Open()
Application.OnKey "{RIGHT}", "HighlightRight"
Application.OnKey "{LEFT}", "HighlightLeft"
Application.OnKey "{UP}", "HighlightUp"
Application.OnKey "{DOWN}", "HighlightDown"
Application.OnKey "{DEL}", "DisableDelete"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "{RIGHT}"
Application.OnKey "{LEFT}"
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
Application.OnKey "{DEL}"
End Sub
Option Explicit
'/////////////////////////////////
'// Original by NateO for aldo ///
'// 24th Jan 2003 ///
'// Amended by IFM ///
'// 28th Jan 2003 ///
'// Amended by Aldo ///
'//
'/////////////////////////////////
'// Placed in a Std Module
Dim strCol As String
Dim iCol As Integer
Dim dblRow As Double
Sub HighlightRight()
HighLight 0, 1
End Sub
Sub HighlightLeft()
HighLight 0, -1
End Sub
Sub HighlightUp()
HighLight -1, 0, -1
End Sub
Sub HighlightDown()
HighLight 1, 0, 1
End Sub
Sub HighLight(dblxRow As Double, iyCol As Integer, Optional dblZ As Double = 0)
'// Amended to highlight Activecell cross intersection
'// Amended as an Alternative to using Condtional Formats
'// As per Aldo thread;
'// http://216.92.17.166/board/viewtopic.php?topic=19239&forum=2&start=20&22
On Error GoTo NoGo
strCol = Mid(ActiveCell.Offset(dblxRow, iyCol).Address, _
InStr(ActiveCell.Offset(dblxRow, iyCol).Address, "$") + 1, _
InStr(2, ActiveCell.Offset(dblxRow, iyCol).Address, "$") - 2)
iCol = ActiveCell.Column
dblRow = ActiveCell.Row
'// If you don't want screen flicker
Application.ScreenUpdating = False

With Range(strCol & ":" & strCol & "," & dblRow + dblZ & ":" & dblRow + dblZ)
.Select
'// Need to reset here!
Application.ScreenUpdating = True
.Item(dblRow + dblxRow).Activate
End With
NoGo:
End Sub

Sub DisableDelete()
Cells(ActiveCell.Row, ActiveCell.Column).Select
Application.OnKey "{DEL}"
End Sub
Sub ReSet()
Application.OnKey "{RIGHT}"
Application.OnKey "{LEFT}"
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
End Sub

My current selection change VBA:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Calendar1.Visible Then Calendar1.Visible = False
If Target.Column < 13 Or Target.Column > 14 Or Target.Count > 1 Then Exit Sub
Calendar1.Left = Target.Left + Target.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
Calendar1.Value = Date
End Sub
Private Sub Calendar1_Click()
ActiveCell = Calendar1.Value
Calendar1.Visible = False
ActiveCell.Select
End Sub




Thanks,

AJ

 

[hiker95]

ajgolfs,

Try:

Using the Worksheet_SelectionChange Event.

Highlighting the Row and Column of the Selected Cell
http://excel.tips.net/Pages/T002457_Highlighting_the_Rows_of_Selected_Cells.html