CODEWITHSUNDEEP
vbaexcelevent-handlingworksheet-function
user3794203
user3794203

Reputation: 235

Adding a parameter to a worksheet event

I have found a macro that works really well to highlight the entire row that corresponds to a selected cell (whatever cell you select, the macro runs, and all rows are highlighted). There are some drawbacks to this current iteration and I cannot seem to find a way to enact parameters I would want to limit the highlighting to a specific number of rows. Any ideas?

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Const cnNUMCOLS As Long = 512
    Const cnHIGHLIGHTCOLOR As Long = 6  'default lt. yellow
    Static rOld As Range
    Static nColorIndices(1 To cnNUMCOLS) As Long
    Dim i As Long


    If Not rOld Is Nothing Then 'Restore color indices
        With rOld.Cells
            If .Row = ActiveCell.Row Then Exit Sub 'same row, don't restore
            For i = 1 To cnNUMCOLS
                .Item(i).Interior.ColorIndex = nColorIndices(i)
               Next i
        End With
    End If
    Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS)
    With rOld
        For i = 1 To cnNUMCOLS
            nColorIndices(i) = .Item(i).Interior.ColorIndex
        Next i
        .Interior.ColorIndex = cnHIGHLIGHTCOLOR
    End With

End Sub

Upvotes: 0

Views: 53

Answers (1)

Tim Williams
Tim Williams

Reputation: 166885

Try this out:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Const cnNUMCOLS As Long = 512
    Const cnHIGHLIGHTCOLOR As Long = 6  'default lt. yellow
    Static rOld As Range
    Static nColorIndices(1 To cnNUMCOLS) As Long
    Dim i As Long, bClear as Boolean, bInRange as Boolean

    bInRange = Not Application.Intersect(Me.Range("11:54"), Target) Is Nothing
    bClear = Not Application.Intersect(Me.Range("A6"), Target) Is Nothing

    'exit if selection is not in the first ten rows or A6
    If Not (bClear Or bInRange) Then Exit Sub

    If Not rOld Is Nothing Then 'Restore color indices
        With rOld.Cells
            If .Row = ActiveCell.Row Then Exit Sub 'same row, don't restore
            For i = 1 To cnNUMCOLS
                .Item(i).Interior.ColorIndex = nColorIndices(i)
               Next i
        End With
    End If

    If Not bInRange Then
        Set rOld = Nothing 
        Exit Sub  ' Exit if we're in A6
    End If

    Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS)
    With rOld
        For i = 1 To cnNUMCOLS
            nColorIndices(i) = .Item(i).Interior.ColorIndex
        Next i
        .Interior.ColorIndex = cnHIGHLIGHTCOLOR
    End With

End Sub

Note: your code is assuming that only a single cell is selected - behaviour might not be as expected if the user selects multiple cells across >1 row

Upvotes: 1

Related Questions