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:

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495
Rory,from what you've given, only the second part of the of the code works, the first part does not fire. It's what I had originally.
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You mean that if you manually change a value in one of the specified cells, that code doesn't fire?
 

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495
The first code is such that when "yes" in typed into the specified cells, it moves the focus to another specified cell, the second part of the code is a workaround to change the colour of the border of a selected cell.

Because the colour of the border was difficult to see, once the focus had been moved to another cell. I used the second part of the code to highlight the border of the selected cell to indicated that the focus had been moved to another cell. I really hope I'm making sense!!
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
I can see what it does. ;)

What I'm asking is exactly what you mean when you say the first part of the code doesn't work? What, if anything, happens?
 

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495

ADVERTISEMENT

ok... when a specified cell is selected and "yes" is entered, when you hit enter it should move to the specified cell (indicated in the code), and thats not happening, it simply moves to the next adjacent cell
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
OK, that's weird. Seems to be some sort of timing problem. Try this:
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 = ActiveCell.Left
    .Top = ActiveCell.Top
    .Width = ActiveCell.Width
    .Height = ActiveCell.Height
  End With
End Sub
 

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495

ADVERTISEMENT

That works to a point, in that when the you hit enter, it moves to the specified cell..... but for merged cells, the red highlighted border is the same size as as one cell, and not the size of the merged cells, also when you manually select any other cell with the mouse or arrows keys it only selects part of the merged cells (ie the original size of the cell), however you can still type in the merged cells, and it will be entered normally. But it would be nice the cursor could adjust to the same size of the merged cells
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Replace Activecell with Activecell.MergeArea
 

Colleen45

Active Member
Joined
Jul 22, 2007
Messages
495
sadly that didn't work.
This is how I changed it, was I right
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With ActiveSheet.Shapes("Rectangle 1")
    .Left = ActiveCell.MergeArea
    .Top = ActiveCell.MergeArea
    .Width = ActiveCell.MergeArea
    .Height = ActiveCell.MergeArea
  End With
End Sub
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,463
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Nope - should have been:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  With ActiveSheet.Shapes("Rectangle 1")
    .Left = ActiveCell.MergeArea.Left
    .Top = ActiveCell.MergeArea.Top
    .Width = ActiveCell.MergeArea.Width
    .Height = ActiveCell.MergeArea.Height
  End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,407
Messages
5,624,587
Members
416,036
Latest member
eloisa manzanarez

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