Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub

    Application.ScreenUpdating = False
    ' Clear the color of all the cells
    Target.Parent.Cells.Interior.ColorIndex = 0
    With Target
        ' Highlight the entire row and column that contain the active cell
        .EntireRow.Interior.ColorIndex = 8
        
    End With
    Application.ScreenUpdating = True
End Sub

Option Explicit


Dim rng As Range, ray
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Dn As Range, c As Long, col As Long
col = 100
If Not rng Is Nothing Then
    c = 0
    For Each Dn In rng
       c = c + 1
       Dn.Interior.Color = ray(c, 1)
    Next Dn
End If
c = 0
Set rng = Cells(Target.Row, 1).Resize(, col)
ReDim ray(1 To rng.Count, 1 To 2)
    For Each Dn In rng
        c = c + 1
        ray(c, 1) = Dn.Interior.Color
    Next Dn
    Cells(Target.Row, 1).Resize(, col).Interior.ColorIndex = 15
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim RowShape As Shape
    
    ' ************************************************
    ' Check if entire rows 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
        
        '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
    
    
    ' Set RowShape to be the SelectedRow
    On Error Resume Next
    Set RowShape = Sh.Shapes("SelectedRow")
    On Error GoTo 0
     
    'If RowShape doesn't exist, then create it
    If RowShape Is Nothing Then
        
        Sh.Shapes.AddShape(msoShapeRectangle, 1, 1, 1, 1).Select
                
        With Selection.ShapeRange
    
            .Fill.Visible = msoFalse ' Remove any fill color
            
            .Name = "SelectedRow"
            
            .Line.Weight = 2 ' Set line thickness e.g. 1, 1.5, 2 etc
            
            .Line.ForeColor.RGB = RGB(146, 208, 80) ' Light Green.
            'Can use vbBlack, vbWhite, vbRed, vbGreen, vbBlue , vbYellow, vbMagenta, vbCyan
            
            'DashStyle = msoLineDash
            ' Can use : msoLineSolid, msoLineSysDot, msoLineSysDash, msoLineDash, msoLineDashDot, msoLineLongDash, msoLineLongDashDot, msoLineLongDashDotDot
            ' Default is msoLineSolid and does not need to be specified
        
        End With
    
    End If
    
    ' ************************************************
    ' Move the SelectedRow shape
    ' ************************************************
    
    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
    
    Target.Select
    
End Sub