Cannot get two subs to run together.

Canadian911Guy

New Member
Joined
Feb 4, 2015
Messages
19
Hello,

I have two subs that I'm trying to get to work on one sheet. First, is this possible? If it is, how do I do it?
NOTE: Each set of code below works perfectly on their own, but I can't get them to work together.
Thanks for any and all help in advance!

VBA Code:
Private Sub PopUp(ByVal Target As Range)
Set Target = Range("W4")
If Target.Value = "HIGH" Then
 Call PostMitChoice_Initialize
End If
If Target.Value = "CATASTROPHIC" Then
Call PostMitChoice_Initialize
End If
End Sub

Private Sub PostMitChoice_Initialize()
Load PostMitChoice
PostMitChoice.Show
End Sub

Code:
Option Explicit

Private Sub High_Risk_Alert(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
Application.EnableEvents = False

   Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
   On Error GoTo exitHandler

   If rngDV Is Nothing Then GoTo exitHandler

   If Not Intersect(Target, rngDV) Is Nothing Then
      If Target.Validation.Type = 3 Then

         strList = Target.Validation.Formula1
         strList = Right(strList, Len(strList) - 1)
         strDVList = strList
         frmDVList.Show
      End If
   End If

exitHandler:
  Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change1(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
  Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler


Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else

  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
   If newVal = "" Then
      'do nothing
   Else
         If oldVal = "" Then
            Target.Value = newVal
         Else
            Target.Value = oldVal & strSep & newVal
         End If
    End If

End If

exitHandler:
  Application.EnableEvents = True
End Sub
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
More explanation on what I'm trying to do...

When I just have the FIRST bit of code (noted above) entered by itself, it runs and works perfectly.
-The FIRST bit of code pops up an alert (userform) based on specific selections from the Data Validation List.​
-As an example: One list has: None, Minor, Moderate, High, Catastrophic.​
-The userform is called only if the user selects HIGH or CATASTROPHIC and does not get called for any other selections from that list.​

When I just have the SECOND bit of code (noted above) entered by itself, it runs and works perfectly.
-This SECOND bit of code pops up a Selection Box based on a Data Validation List AND it allows for more than one selection from that list.​
-As an example: One list has: Health, Safety, Environment, Public, City, External​
-When the Selection Box pops up, the user can select one or more from the list to be entered into the cell.​

When I put both FIRST & SECOND bits of codes together in the same sheet, neither runs or works.

So, I need both bits of code to run together and work together. Is this possible?
 
Upvote 0
I should also note ... I only need the FIRST bit of code that calls the userform to work in COLUMN "W" ONLY, it does not need to work in any other column.
So, when the user selects from the Popup Selection Box (Second bit of code above) in COLUMN W is either HIGH or CATASTROPHIC, then the userform must be called.
The userform is not required anywhere else in the sheet/workbook. The SECOND bit of code above must be available throughout the entire sheet.
 
Upvote 0
I figured it out!!!

I just started moving part of the FIRST bit of code (RED BOLDED below) into the SECOND bit of code and it eventually worked when I found the right spot to place that little snippet of code!!

Code:
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
Application.EnableEvents = False

    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler

    If rngDV Is Nothing Then GoTo exitHandler

    If Not Intersect(Target, rngDV) Is Nothing Then
        If Target.Validation.Type = 3 Then
            strList = Target.Validation.Formula1
            strList = Right(strList, Len(strList) - 1)
            strDVList = strList
            frmDVList.Show
        If Target.Value = "HIGH" Then
            Call PostMitChoice_Initialize
        End If
        If Target.Value = "CATASTROPHIC" Then
            Call PostMitChoice_Initialize
        End If
      End If
   End If
exitHandler:
  Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change1(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
  Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
   If newVal = "" Then
      'do nothing
   Else
         If oldVal = "" Then
            Target.Value = newVal
         Else
            Target.Value = oldVal & strSep & newVal
         End If
    End If
End If
exitHandler:
  Application.EnableEvents = True
End Sub

Private Sub PostMitChoice_Initialize()
    Load PostMitChoice
    PostMitChoice.Show
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,214,813
Messages
6,121,706
Members
449,048
Latest member
81jamesacct

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