Option Explicit Private WithEvents App As Application Private Sub Workbook_Open() Set App = Application End Sub Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) ' Written by Philip Treacy, http://www.myonlinetraininghub.com/highlight-selected-cells-in-excel-and-preserve-cell-formatting ' Dim RowShape As Shape, ColShape As Shape ' ************************************************ ' Check if entire rows or columns are selected ' If they are then hide the shapes ' ************************************************ If Target.Address = Selection.EntireRow.Address Then 'If error occurs because shape does not exist, ignore the error On Error Resume Next Sh.Shapes("SelectedRow").Visible = msoFalse Sh.Shapes("SelectedCol").Visible = msoFalse 'Return error handling to Excel On Error GoTo 0 Exit Sub End If If Target.Address = Selection.EntireColumn.Address Then 'If error occurs because shape does not exist, ignore the error On Error Resume Next Sh.Shapes("SelectedCol").Visible = msoFalse Sh.Shapes("SelectedRow").Visible = msoFalse 'Return error handling to Excel On Error GoTo 0 Exit Sub End If ' ************************************************ ' ************************************************ ' Create shapes on active sheet if they don't exist ' ************************************************ ' Set RowShape and ColShape to be the SelectedRow and SelectedCol shapes respectively On Error Resume Next Set RowShape = Sh.Shapes("SelectedRow") Set ColShape = Sh.Shapes("SelectedCol") On Error GoTo 0 'If RowShape doesn't exist, then create it If RowShape Is Nothing Then Sh.Shapes.AddShape(msoShapeRectangle, 1, 1, 300, 300).Select With Selection.ShapeRange .Fill.Visible = msoFalse .Name = "SelectedRow" .Line.Weight = 2 .Line.ForeColor.RGB = RGB(146, 208, 80) ' Light Green. ' 'Can use vbBlack, vbWhite, vbRed, vbGreen, vbBlue , vbYellow, vbMagenta, vbCyan End With End If 'If ColShape doesn't exist, then create it If ColShape Is Nothing Then Sh.Shapes.AddShape(msoShapeRectangle, 1, 1, 1, 1).Select With Selection.ShapeRange .Fill.Visible = msoFalse .Name = "SelectedCol" .Line.Weight = 2 .Line.ForeColor.RGB = RGB(146, 208, 80) ' Light Green End With End If ' ************************************************ ' ************************************************ ' Move the SelectedRow and SelectedCol shapes ' ************************************************ With Sh.Shapes("SelectedRow") .Visible = msoTrue 'Make sure it is visible, it may have been hidden by previous selection .Top = Target.Top .Left = ActiveWindow.VisibleRange.Left .Width = ActiveWindow.VisibleRange.Width .Height = Target.Height End With With Sh.Shapes("SelectedCol") .Visible = msoTrue 'Make sure it is visible, it may have been hidden by previous selection .Top = ActiveWindow.VisibleRange.Top .Left = Target.Left .Width = Target.Width .Height = ActiveWindow.VisibleRange.Height End With ' ************************************************ Target.Select ' Must do this to stop shape being selected if navigating with cursor keys End Sub