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