Merge 2 dİfferent vba code

[engbaris]

hi everyone,

I have 2 different code which one of this allows you to select multiple item from a drop-down list while the other code sends automatic outlook mail.

You can find these two code following;

As far as I know, to be able to run these code in the same excel sheet, ı have to merge these codes.

Can you help me to do this?



Private Sub Worksheet_Change(ByVal Target As Range)


Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 5 And Target.Row > 2 And Target.Row < 1038 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub







Option Explicit


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"


MyLimit = 0

Set FormulaRange = Me.Range("U3:U15")


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 Mail_with_outlook
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

 

[Worf]

Welcome to the Board

The two codes can work from the same sheet module; however, they are triggered by distinct events. When exactly do you want each one to run?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String, Newvalue$
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 5 And Target.Row > 2 And Target.Row < 1038 Then
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
    Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target
    Application.Undo
    Oldvalue = Target
    If Oldvalue = "" Then
        Target.Value = Newvalue
    Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target = Oldvalue & ", " & Newvalue
        Else
            Target = Oldvalue
        End If
    End If
    End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Calculate()
Dim FormulaRange As Range, NotSentMsg$, formulacell As Range
Dim MyMsg As String, SentMsg$, MyLimit#
NotSentMsg = "Not Sent"
SentMsg = "Sent"
MyLimit = 0
Set FormulaRange = Me.[U3:U15]
On Error GoTo EndMacro:
For Each formulacell In FormulaRange.Cells
    With formulacell
        If Not IsNumeric(.Value) Then
            MyMsg = "Not numeric"
        Else
            If .Value = MyLimit Then
                MyMsg = SentMsg
                If .Offset(, 1) = NotSentMsg Then Mail_with_outlook
            Else
                MyMsg = NotSentMsg
            End If
        End If
        Application.EnableEvents = False
        .Offset(, 1) = MyMsg
        Application.EnableEvents = True
    End With
Next
ExitMacro:
Exit Sub
EndMacro:
Application.EnableEvents = True
MsgBox "Some Error occurred." & vbLf & Err.Number & vbLf & Err.Description
End Sub