How to combine similar Private Sub Worksheets?

[Rita9091]

Hello all,

I am trying to figure out how to combine two very similar Private Sub Worksheets. Ideally....they would run one after the other, and create different emails (one to staff and one to client). What it does is look at my worksheet, and if the value in the formula cell is > 0...it launches an email macro. The second, is identical, except it checks a different cell, and launches a different email macro. I also need to add something in that if the cell queried is "0" then do nothing...or don't send anything, but I'm not sure how to integrate that.

Here is the first code:

Private Sub Worksheet_Calculate()
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimit As Double

    NotSentMsg = "Not Sent"
    SentMsg = "Sent"

    'Above the MyLimit value it will run the macro
    MyLimit = 0

    'Set the range with the Formula that you want to check
    Set FormulaRange = Me.Range("Q101")

    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = "Not numeric"
            Else
                If .Value > MyLimit Then
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = NotSentMsg Then
                        Call JC_Mail
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell

ExitMacro:
    Exit Sub

EndMacro:
    Application.EnableEvents = True

    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description

End Sub

And here is the second.

Private Sub Worksheet_Calculate()
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimit As Double

    NotSentMsg = "Not Sent"
    SentMsg = "Sent"

    'Above the MyLimit value it will run the macro
    MyLimit = 0

    'Set the range with the Formula that you want to check
    Set FormulaRange = Me.Range("R101")

    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = "Not numeric"
            Else
                If .Value > MyLimit Then
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = NotSentMsg Then
                        Call JC_Mail2
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell

ExitMacro:
    Exit Sub

EndMacro:
    Application.EnableEvents = True

    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description

End Sub

Can anyone help,
Thank you
RC

 

[aaewalsh]

Try This:

Private Sub Worksheet_Calculate()
Dim FormulaRange1 As Range
Dim FormulaRange2 As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double
NotSentMsg = "Not Sent"
SentMsg = "Sent"

'Above the MyLimit value it will run the macro
MyLimit = 0

'Set the range with the Formula that you want to check
Set FormulaRange1 = Me.Range("Q101")
Set FormulaRange2 = Me.Range("R101")

On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange1.Cells
    With FormulaCell
        If IsNumeric(.Value) = False Then
            MyMsg = "Not numeric"
        Else
            If .Value > MyLimit Then
                MyMsg = SentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    Call JC_Mail
                End If
            Else
                MyMsg = NotSentMsg
            End If
        End If
        Application.EnableEvents = False
        .Offset(0, 1).Value = MyMsg
        Application.EnableEvents = True
    End With
Next FormulaCell

For Each FormulaCell In FormulaRange2.Cells
    With FormulaCell
        If IsNumeric(.Value) = False Then
            MyMsg = "Not numeric"
        Else
            If .Value > MyLimit Then
                MyMsg = SentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    Call JC_Mail2
                End If
            Else
                MyMsg = NotSentMsg
            End If
        End If
        Application.EnableEvents = False
        .Offset(0, 1).Value = MyMsg
        Application.EnableEvents = True
    End With
Next FormulaCell
ExitMacro:
Exit Sub

EndMacro:
Application.EnableEvents = True
MsgBox "Some Error occurred." _
     & vbLf & Err.Number _
     & vbLf & Err.Description
End Sub

 

[HaHoBe]

Hi Rita,

as the ranges to compare are directly connected to each other I changed the offset to put the mesaage to to be one row below instead overwriting an existing formula:

Private Sub Worksheet_Calculate()
  Dim FormulaRange As Range
  Dim FormulaCell As Range
  Dim NotSentMsg As String
  Dim MyMsg As String
  Dim SentMsg As String
  Dim MyLimit As Double

  NotSentMsg = "Not Sent"
  SentMsg = "Sent"

  'Above the MyLimit value it will run the macro
  MyLimit = 0

  'Set the range with the Formula that you want to check
  Set FormulaRange = Range("Q101,R101")

  On Error GoTo EndMacro:
  For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
      If IsNumeric(.Value) = False Then
        MyMsg = "Not numeric"
      Else
        If .Value > MyLimit Then
          MyMsg = SentMsg
          If .Offset(1, 0).Value <> NotSentMsg Then
            If .Address = "$Q$101" Then
              Call JC_Mail
            ElseIf .Address = "$R$101" Then
              Call JC_Mail2
            End If
          End If
        Else
          MyMsg = NotSentMsg  'I'd preferred to use "" instead: why not sent when value doesn't fit criteria
        End If
      End If
      Application.EnableEvents = False
      .Offset(1, 0).Value = MyMsg
      Application.EnableEvents = True
    End With
  Next FormulaCell

ExitMacro:
  Exit Sub

EndMacro:
  Application.EnableEvents = True

  MsgBox "Some Error occurred." _
       & vbLf & Err.Number _
       & vbLf & Err.Description

End Sub

Ciao,
Holger

 

[Rita9091]

Thank you both very much! Holger, I went with your code as your solution to move the notification text was very helpful.