Rows to be highlighted once selected

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,227
Office Version
  1. 2007
Platform
  1. Windows
Morning,
Maybe you could assist me please.

I have the following code supplied below.
The code at present works for rows 29 & 30 but im thinking of it also needs to work for rows 4 to 28 but another color.
is this possible please & could you advise how / where i need to apply the additional info.



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 = "A"
    myEndCol = "G"


'   *** Specify start row ***
    myStartRow = 29
    
'   Use first column to find the last row
    myLastRow = 30
    
'   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 = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    
'   This color will Highlight the cell in the row
    Target.Interior.Color = vbRed
    Application.ScreenUpdating = True


End Sub


Have a nice day.
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
You macro does not highlight the selected cell, so this one neither
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 = "A"
    myEndCol = "G"

'   *** Specify start row ***
    If (Target.Row > 3 And Target.Row < 29) Then
          myStartRow = 4
    Else: myStartRow = 29
    End If
'   Use first column to find the last row
    If (Target.Row > 3 And Target.Row < 29) Then
          myLastRow = 28
    Else: myLastRow = 30
    End If
    
'   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 = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 5
    Else
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    End If
'   This color will Highlight the cell in the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Target.Interior.Color = vbBlue
    Else
    Target.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True

End Sub

but if you want to
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 = "A"
    myEndCol = "G"

'   *** Specify start row ***
    If (Target.Row > 3 And Target.Row < 29) Then
          myStartRow = 4
    Else: myStartRow = 29
    End If
'   Use first column to find the last row
    If (Target.Row > 3 And Target.Row < 29) Then
          myLastRow = 28
    Else: myLastRow = 30
    End If
    
'   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 = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 5
    Else
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    End If
'   This color will Highlight the cell in the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Target.Interior.Color = vbRed
    Else
    Target.Interior.Color = vbBlue
    End If
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Many thanks.

I only require the row to be highlighted once the cell is selected.
Currently with your code supplied i see say Row 29 RED with the selected cell BLUE but if i then select say cell B10 the row is BLUE and the selected cell is RED.

I only need to see 1 row change color when the cell is selected.
If i selected say cell B10 the row 29 & 30 should then have NO color fill so must be white.

Many thanks
 
Upvote 0
Hi,

What about changing
Code:
[LEFT][COLOR=#333333][FONT=monospace]myRange.Interior.ColorIndex = 2[/FONT][/COLOR][/LEFT]
into
Code:
[LEFT][COLOR=#222222][FONT=Verdana]Range("A4:G30")[COLOR=#333333][FONT=monospace].Interior.ColorIndex = 2[/FONT][/COLOR][/FONT][/COLOR][/LEFT]
?
 
Last edited:
Upvote 0
Many thanks for the advice.

I have the following code in use.
All is good apart from the selected cell color for range A4:A28
Selected cell needs to be Interior.ColorIndex = 8 but currently it is 3
See attached photos


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 = "A"
    myEndCol = "G"


'   *** Specify start row ***
    If (Target.Row > 3 And Target.Row < 29) Then
          myStartRow = 4
    Else: myStartRow = 29
    End If
'   Use first column to find the last row
    If (Target.Row > 3 And Target.Row < 29) Then
          myLastRow = 28
    Else: myLastRow = 30
    End If
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    Range("A4:G30").Interior.ColorIndex = 2
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   This color will Highlight the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
    Else
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
    End If
'   This color will Highlight the cell in the row
    If (Target.Row > 3 And Target.Row < 29) Then
    Target.Interior.Color = vbRed
    Else
    Target.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True


End Sub
http://www.theremotedoctor.co.uk/forums/4286.jpg

http://www.theremotedoctor.co.uk/forums/4287.jpg
 
Upvote 0
Simply delete the red part:


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 = "A"
myEndCol = "G"


' *** Specify start row ***
If (Target.Row > 3 And Target.Row < 29) Then
myStartRow = 4
Else: myStartRow = 29
End If
' Use first column to find the last row
If (Target.Row > 3 And Target.Row < 29) Then
myLastRow = 28
Else: myLastRow = 30
End If

' Build range to apply this to
Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))

' Clear the color of all the cells in range
Range("A4:G30").Interior.ColorIndex = 2

' Check to see if cell selected is outside of range
If Intersect(Target, myRange) Is Nothing Then Exit Sub

' This color will Highlight the row
If (Target.Row > 3 And Target.Row < 29) Then
Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
Else
Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
End If
'
This color will Highlight the cell in the row
If (Target.Row > 3 And Target.Row < 29) Then
Target.Interior.Color = vbRed
Else
Target.Interior.Color = vbRed
End If
Application.ScreenUpdating = True


End Sub
 
Last edited:
Upvote 0
I am sorry.
My mind was playing games with me.

You are correct & working perfect.

thanks for your time with this.
have a nice day.
 
Upvote 0
No problem, often the case when spend too much time in excel.

Thanks for the feed back, have a nice day
 
Upvote 0

Forum statistics

Threads
1,215,461
Messages
6,124,954
Members
449,198
Latest member
MhammadishaqKhan

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