Existing code to now operate two ranges

[ipbr21054]

Morning all,

I have the below working code which highlights a certain selection of cells for easier viewing.

My request please is that i also need the same to happen but for another range in the same worksheet.
Please could you advise an edit/fix so this is possible for me.

It will be the same start row & colour index, but i need to add into the equation the extra range,

Mystartcol = Y and also BC
Myendcolumn = AH and also BY

Private Sub Worksheet_SelectionChange(ByVal Target As Range)    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "Y"
    myEndCol = "AH"


'   *** Specify start row ***
    myStartRow = 2
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Highlight the row and column that contain the active cell
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
Target.Interior.Color = vbGreen
    Application.ScreenUpdating = True


End Sub

Many Thanks

 

[JackDanIce]

Try:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim LR          As Long
    Dim startCol    As Variant
    Dim temp        As Variant
    Dim rng         As Range
    
    Const startRow  As Long = 2
    
    If Target.Cells.count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
    For Each startCol In Array("Y|AH", "BC|BY")
        temp = Split(startCol, "|")
        LR = Range(temp(0) & Rows.count).End(xlUp).row
        Set rng = Range(temp(0) & startRow, temp(1) & LR)
        rng.Interior.ColorIndex = 6
        If Not Intersect(Target, rng) Is Nothing Then
            Range(temp(0) & Target.row, temp(1) & Target.row).Interior.ColorIndex = 8
            Target.Interior.Color = vbGreen
        End If
        Set rng = Nothing
        Erase temp
    Next startCol
    
    Application.ScreenUpdating = True

End Sub

 

[ipbr21054]

Worked a treat.

Thanks very much

 

[JackDanIce]

You're welcome