why wont these two codes work together

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495
These two codes work fine individually, but together (as they are below)I can't get them to work together, and I can't figure out why.

Code:
Option Explicit
Rem If cell = "yes" move cursor focus to selected cell
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub ' only one cell changes
If Not Intersect(Target, Range("E191,E197,E202,E212,F231,F233,F235,F251,F254,F260")) Is Nothing Then
    If LCase(Target.Value) = "yes" Then
        Application.EnableEvents = False
        Select Case Target.Address(0, 0)
            Case "E191": Range("G187").Select
            Case "E197": Range("G193").Select
            Case "E202": Range("G200").Select
            Case "E212": Range("G205").Select
            Case "F231": Range("I230").Select
            Case "F233": Range("I232").Select
            Case "F235": Range("I234").Select
            Case "F251": Range("H247").Select
            Case "F254": Range("H247").Select
            Case "F260": Range("H257").Select
        End Select
        Application.EnableEvents = True
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With ActiveSheet.Shapes("Rectangle 1")
    .Left = Target.Left
    .Top = Target.Top
    .Width = Target.Width
    .Height = Target.Height
  End With
  Target.Activate
End Sub
 
Last edited:

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,012
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Maybe combine them like this
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub ' only one cell changes
If Not Intersect(Target, Range("E191,E197,E202,E212,F231,F233,F235,F251,F254,F260")) Is Nothing Then
    If LCase(Target.Value) = "yes" Then
        Application.EnableEvents = False
        Select Case Target.Address(0, 0)
            Case "E191": Range("G187").Select
            Case "E197": Range("G193").Select
            Case "E202": Range("G200").Select
            Case "E212": Range("G205").Select
            Case "F231": Range("I230").Select
            Case "F233": Range("I232").Select
            Case "F235": Range("I234").Select
            Case "F251": Range("H247").Select
            Case "F254": Range("H247").Select
            Case "F260": Range("H257").Select
        End Select
        Application.EnableEvents = True
    End If
End If
  With ActiveSheet.Shapes("Rectangle 1")
    .Left = Target.Left
    .Top = Target.Top
    .Width = Target.Width
    .Height = Target.Height
  End With
  Target.Activate
End Sub
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,012
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Did you put the code in the sheet module ?
 

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495

ADVERTISEMENT

Yes, the worksheet is sheet 2, and that is where I put the code
The original code was in the same worksheet, So I removed that code and replaced it with yours
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,012
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
OK, so are you changing some data in the sheet...it won't fire if nothing has been changed
 

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495

ADVERTISEMENT

What I did was as I mentioned previously, completely remove the code and replaced it with your code. Then I went back to the worksheet and tried to change data, which did not fire to move the cursor. The red border aound the selected cell, does not move when selected with the mouse. I see what you have done in combining the code, but don't understand why they don't want to work together, when they work fine individually.
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,012
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
OK, I'm a little confused....what does the Shape have to do with a red border around the cell ??
 

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495
It is a workaround code to change the colour of the border around a selected cell. Shapes is the name of the rectangle used to create a border, because you can't normally change the colour of the border around a selected cell in Excel. The code that is there, works very well.
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,414
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You're disabling events in the first code, so when it selects a new cell, the SelectionChange code won't run. You need:
Code:
Option Explicit
Rem If cell = "yes" move cursor focus to selected cell
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub ' only one cell changes
If Not Intersect(Target, Range("E191,E197,E202,E212,F231,F233,F235,F251,F254,F260")) Is Nothing Then
    If LCase(Target.Value) = "yes" Then
        Select Case Target.Address(0, 0)
            Case "E191": Range("G187").Select
            Case "E197": Range("G193").Select
            Case "E202": Range("G200").Select
            Case "E212": Range("G205").Select
            Case "F231": Range("I230").Select
            Case "F233": Range("I232").Select
            Case "F235": Range("I234").Select
            Case "F251": Range("H247").Select
            Case "F254": Range("H247").Select
            Case "F260": Range("H257").Select
        End Select
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With ActiveSheet.Shapes("Rectangle 1")
    .Left = Target.Left
    .Top = Target.Top
    .Width = Target.Width
    .Height = Target.Height
  End With
  Target.Activate
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,126,957
Messages
5,621,827
Members
415,859
Latest member
Vain

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
Top