Code not working as it should

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Hi,
I was just looking for a basic code that when i select a cell it would turn Red.
When i leave that cell & select another it would revert back to its original colour & the new selected cell would then take on board the red colour.
What i am finding is this.
My whole sheet is yellow.
I select cell A1 & it then turns Red.
I then select cell B4.
Now cell A1 turns back to Yellow & now cell B4 is Red
So now looking at my sheet all cells are Yellow apart from the last selected cell of which in this case is B4
I save the sheet & close it.

Next time i open the sheet i see cell B4 is Red so i click in cell B22
Now i have cell B4 Red & also cell B22 Red

As i click around the code does what it should do but cell B4 is still Red.
I click cell Z1 save & close the worksheet.

Now when i open the worksheet i have cell Z1 & cell B4 Red so i start clicking around but these two cells dont change.
So every time i save & close the sheet the last selected cell will then be added each time to my growing Red cells.
Z1 B4 etc etc etc

Here is the code in use.

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Static rngPrev As Range, PrevColor As Integer
    Dim TempColor As Integer
    TempColor = Target.Cells(1, 1).Interior.ColorIndex


    If Not rngPrev Is Nothing Then rngPrev.Interior.ColorIndex = PrevColor
    PrevColor = TempColor


    With Target.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
    Set rngPrev = Target


End Sub
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Try:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    ActiveSheet.Cells.Interior.ColorIndex = 6
    Target.Interior.ColorIndex = 3
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi,
works much better.
Can you edit it so column D is not affected by it.
Reason being a have some coloured cells in column D of which this code wipes out & returns them to yellow.
This wasnt mentioned as i thought my original code would be edited & thus did not affect column D

Otherwise great
Thanks
 
Upvote 0
Try:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Range("A:C,E:BB").Interior.ColorIndex = 6
    Target.Interior.ColorIndex = 3
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi,
That allowed me to select a cell in column D of which it stayed red.
The more i selected in column D the red cells i had.

Can we have a range set up like so.
Range for red cell Columns A-I
Row 8 then down the page until the last row of which is currently 902 but as i add items 902 will become 903 904 905 etc etc

With the above now sorted omit column D
 
Upvote 0
I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do using a few examples from your data and referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Try:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Intersect(Target, Range("A:I")) Is Nothing Then Exit Sub
    If Target.Column <> 4 Then
        Range("A8:C" & LastRow).Interior.ColorIndex = 6
        Range("E8:I" & LastRow).Interior.ColorIndex = 6
        Target.Interior.ColorIndex = 3
    End If
    Application.ScreenUpdating = True
End Sub
By the way, the reason your file is so big is because many of your sheets recognize more than one million rows. If you go to each sheet, hold down the CRTL key and press the END key, it will take you to the last recognized cell. You could delete all the extra rows and columns and then immediately save and close the file. When you re-open it, it should be much smaller.
 
Upvote 0
Hi,
In that file the last row is 902 can you please click in cells on row 903 A through to I
It turns all of them Red.
You are then able to select any other cell of which turns red but row 903 is all still Red

Looks like it could be advising the user to the next available row for where the data is next going to be entered thus this is shown in red ?
 
Upvote 0
Replace this line of code:
Code:
If Intersect(Target, Range("A:I")) Is Nothing Then Exit Sub
with this line:
Code:
If Intersect(Target, Range("A8:I" & LastRow)) Is Nothing Then Exit Sub
 
Upvote 0

Forum statistics

Threads
1,214,929
Messages
6,122,315
Members
449,081
Latest member
tanurai

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