Combine two Worksheet_SelectionChange Events

[jeffreybrown]

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.

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

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

 

[VoG]

Untested but try

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.

 

[jeffreybrown]

Yes Vog...works grand...thanks