View Single Post
 
Old 04-28-2018, 04:28 PM
Logit Logit is offline Windows 10 Office 2007
Expert
 
Join Date: Jan 2017
Posts: 587
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

.
This should work for you. The macro is pasted in ThisWorkbook module so it affects all
sheets in the workbook. If you want it for only one sheet, you can move the macro into
that sheets module:

Code:
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
Attached Files
File Type: xlsm worbook-highlight-test.xlsm (18.7 KB, 13 views)
Reply With Quote