i want to add 3 subs to one page of which 2 different actions will do a message box email
this is how i did it but it isnt working
what am i doing wrong?
macro1 worked on its own so did macro2
macro2 is broken to begin with
macro3 worked on its own
Private Sub Worksheet_Change(ByVal Target As Range)
Macro1 Target 'event runs when cell in Column E or column F is changed
Macro2 Target 'event runs when cell in Column K is changed
Macro3 Target 'event runs when cell in Column B is changed
End Sub
Private Sub Macro1(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Cells(Target.Row, "A").Value <> "" And Cells(Target.Row, "E").Value = "_Approvals Missing" And Cells(Target.Row, "F").Value <> "" Or _
Cells(Target.Row, "F").Value <> "" And Cells(Target.Row, "E").Value = "_Approvals Missing" Then
result = MsgBox("pressing OK will send email to notify", vbOKOnly + vbExclamation, "Missing Approval")
If result = vbOK Then
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
newmsg.Recipients.Add ("mail@mail.org") ' Add Recipients
newmsg.Subject = Cells(Target.Row, "A").Value & "Missing Approval" ' Add Subject
newmsg.Body = "Missing Approval" & vbCrLf & "" & _
"Please get approval for " & _
Cells(Target.Row, "A").Value & _
" for Missing Class/Membership: " & _
Cells(Target.Row, "F").Value ' Email Body
newmsg.Display 'Display Email
newmsg.Send 'Send Email
MsgBox "Outlook message sent", , "Outlook message sent" ' Confirm Sent Email
End If
End If
End If
End Sub
Private Sub Macro2(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Cells(Target.Row, "A").Value <> "" And Cells(Target.Row, "K").Value = "x" And Cells(Target.Row, "M").Value <> "" Then
result = MsgBox("pressing OK will send email to notify", vbOKOnly + vbExclamation, "Missing Approval")
If result = vbOK Then
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
newmsg.Recipients.Add ("mail@mail.org") ' Add Recipients
newmsg.Subject = Cells(Target.Row, "A").Value & "Missing Approval" ' Add Subject
newmsg.Body = "Missing Approval" & vbCrLf & "" & _
"Please get approval for " & _
Cells(Target.Row, "A").Value & _
Cells(Target.Row, "E").Value & _
Cells(Target.Row, "M").Value ' Email Body
newmsg.Display 'Display Email
newmsg.Send 'Send Email
MsgBox "Outlook message sent", , "Outlook message sent" ' Confirm Sent Email
End If
End If
End If
End Sub
Private Sub Macro2(ByVal Target As Range)
Dim svcMonth As Date
Dim bDate As Date
Dim sAge As Long
svcMonth = Cells(Target.Row, "B")
If Target.Column = 4 And Target.Cells.Count = 1 Then 'Is the user changing one cell in column 4?
If Target.Value = "OTPS Phone Serv" Or Target.Value = "OTPS Internet" Or Target.Value = "OTPS CLOTHING" Or Target.Value = "OTPS Utilities" Then 'Check if the change is questionable
bDate = Cells(Target.Row, "P")
sAge = DateDiff("yyyy", bDate, svcMonth)
If sAge < 18 Then
Cells(Target.Row, "M") = "Special Approval Needed"
End If
End If
End If
End Sub
this is how i did it but it isnt working
what am i doing wrong?
macro1 worked on its own so did macro2
macro2 is broken to begin with
macro3 worked on its own
Private Sub Worksheet_Change(ByVal Target As Range)
Macro1 Target 'event runs when cell in Column E or column F is changed
Macro2 Target 'event runs when cell in Column K is changed
Macro3 Target 'event runs when cell in Column B is changed
End Sub
Private Sub Macro1(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Cells(Target.Row, "A").Value <> "" And Cells(Target.Row, "E").Value = "_Approvals Missing" And Cells(Target.Row, "F").Value <> "" Or _
Cells(Target.Row, "F").Value <> "" And Cells(Target.Row, "E").Value = "_Approvals Missing" Then
result = MsgBox("pressing OK will send email to notify", vbOKOnly + vbExclamation, "Missing Approval")
If result = vbOK Then
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
newmsg.Recipients.Add ("mail@mail.org") ' Add Recipients
newmsg.Subject = Cells(Target.Row, "A").Value & "Missing Approval" ' Add Subject
newmsg.Body = "Missing Approval" & vbCrLf & "" & _
"Please get approval for " & _
Cells(Target.Row, "A").Value & _
" for Missing Class/Membership: " & _
Cells(Target.Row, "F").Value ' Email Body
newmsg.Display 'Display Email
newmsg.Send 'Send Email
MsgBox "Outlook message sent", , "Outlook message sent" ' Confirm Sent Email
End If
End If
End If
End Sub
Private Sub Macro2(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Cells(Target.Row, "A").Value <> "" And Cells(Target.Row, "K").Value = "x" And Cells(Target.Row, "M").Value <> "" Then
result = MsgBox("pressing OK will send email to notify", vbOKOnly + vbExclamation, "Missing Approval")
If result = vbOK Then
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
newmsg.Recipients.Add ("mail@mail.org") ' Add Recipients
newmsg.Subject = Cells(Target.Row, "A").Value & "Missing Approval" ' Add Subject
newmsg.Body = "Missing Approval" & vbCrLf & "" & _
"Please get approval for " & _
Cells(Target.Row, "A").Value & _
Cells(Target.Row, "E").Value & _
Cells(Target.Row, "M").Value ' Email Body
newmsg.Display 'Display Email
newmsg.Send 'Send Email
MsgBox "Outlook message sent", , "Outlook message sent" ' Confirm Sent Email
End If
End If
End If
End Sub
Private Sub Macro2(ByVal Target As Range)
Dim svcMonth As Date
Dim bDate As Date
Dim sAge As Long
svcMonth = Cells(Target.Row, "B")
If Target.Column = 4 And Target.Cells.Count = 1 Then 'Is the user changing one cell in column 4?
If Target.Value = "OTPS Phone Serv" Or Target.Value = "OTPS Internet" Or Target.Value = "OTPS CLOTHING" Or Target.Value = "OTPS Utilities" Then 'Check if the change is questionable
bDate = Cells(Target.Row, "P")
sAge = DateDiff("yyyy", bDate, svcMonth)
If sAge < 18 Then
Cells(Target.Row, "M") = "Special Approval Needed"
End If
End If
End If
End Sub