Combine two Worksheet_SelectionChange Events

jeffreybrown

Well-known Member
Joined
Jul 28, 2004
Messages
5,145
Hi All,

I currently use the first macro in my spreadsheet which controls a text box. I would like to add the second macro to the first, but not sure how. Also, on the second macro I would like to apply it to more than just column 4. I tried using the If Intersect construct but I can't quite get the syntax right.

Code:
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strTitle As String
Dim strMsg As String
Dim sTemp As Shape
Dim lDVType As Long
Dim ws As Worksheet
    Application.EnableEvents = False
Set ws = ActiveSheet
Set sTemp = ws.Shapes("txtInputMsg")
On Error Resume Next
lDVType = 0
lDVType = Target.Validation.Type
On Error GoTo errHandler
  If lDVType = 0 Then
   sTemp.TextFrame.Characters.Text = ""
   sTemp.Visible = msoFalse
  Else
    If Target.Validation.InputTitle <> "" Or _
          Target.Validation.InputMessage <> "" Then
      strTitle = Target.Validation.InputTitle & Chr(10)
      strMsg = Target.Validation.InputMessage
      With sTemp.TextFrame
        .Characters.Text = strTitle & strMsg
        .Characters.Font.Bold = False
        .Characters(1, Len(strTitle)).Font.Bold = True
      End With
      sTemp.Visible = msoTrue
    Else
      sTemp.TextFrame.Characters.Text = ""
      sTemp.Visible = msoFalse
    End If
  End If
errHandler:
  Application.EnableEvents = True
End Sub
Code:
Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 4 Then 
        ActiveWindow.Zoom = 120
        SendKeys "%{down}"
    Else: ActiveWindow.Zoom = 100
    End If
End Sub
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Untested but try

Rich (BB code):
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strTitle As String
Dim strMsg As String
Dim sTemp As Shape
Dim lDVType As Long
Dim ws As Worksheet
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("D1:G5000")) Is Nothing Then
    ActiveWindow.Zoom = 120
    SendKeys "%{down}"
Else: ActiveWindow.Zoom = 100
End If
Application.EnableEvents = False
Set ws = ActiveSheet
Set sTemp = ws.Shapes("txtInputMsg")
On Error Resume Next
lDVType = 0
lDVType = Target.Validation.Type
On Error GoTo errHandler
  If lDVType = 0 Then
   sTemp.TextFrame.Characters.Text = ""
   sTemp.Visible = msoFalse
  Else
    If Target.Validation.InputTitle <> "" Or _
          Target.Validation.InputMessage <> "" Then
      strTitle = Target.Validation.InputTitle & Chr(10)
      strMsg = Target.Validation.InputMessage
      With sTemp.TextFrame
        .Characters.Text = strTitle & strMsg
        .Characters.Font.Bold = False
        .Characters(1, Len(strTitle)).Font.Bold = True
      End With
      sTemp.Visible = msoTrue
    Else
      sTemp.TextFrame.Characters.Text = ""
      sTemp.Visible = msoFalse
    End If
  End If
errHandler:
  Application.EnableEvents = True
End Sub

Change the range in red to suit.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,658
Messages
5,597,403
Members
414,142
Latest member
Banyangt

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