Existing code to now operate two ranges

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,738
Office Version
  1. 2007
Platform
  1. Windows
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

Code:
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
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Try:
Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top