3rd macro of the sheet

R

rjmdc

Well-known Member
Joined
Apr 29, 2020
Messages
672
Office Version
  1. 365
Platform
  1. Windows
i did something wrong
i was trying to reverse that both M and O need to be filled in see the red typing. this part of code is wrong it only works if first o is filled in and then i fill in M with the X
how can i do in the reverse as well?


VBA Code: 
Private Sub Macro3(ByVal Target As Range)

Dim Submission As String
Submission = Cells(Target.Row, "M")

I[COLOR=rgb(184, 49, 47)]f Target.Column = 13 And Target.Cells.Count = 1 Then
If Cells(Target.Row, "B").Value <> "" Then
If AscW(Target.Value & " ") = 10006 And Cells(Target.Row, "O").Value <> "" Or _
Cells(Target.Row, "O").Value <> "" And AscW(Target.Value & " ") = 10006 Then[/COLOR]

        result = MsgBox("pressing OK will send email reminder", 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 ("[EMAIL]mail@mail.org[/EMAIL]") ' Add Recipients
            newmsg.Subject = Cells(Target.Row, "B").Value & "Submitted Incorrectly"  ' Add Subject
            newmsg.Body = "This is a reminder to inform" & vbCrLf & "" & _
                          "Broker/Mom that   " & _
                          Cells(Target.Row, "B").Value & "   for" & _
                          Cells(Target.Row, "C").Value & "   for" & _
                          Cells(Target.Row, "F").Value & "   " & " " & _
                          Cells(Target.Row, "G").Value & "  " & " " & _
                          Cells(Target.Row, "O").Value & "   as per X on grid"  '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 If
End Sub
 
Last edited by a moderator:

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
If AscW(Target.Value & " ") = 10006 And Cells(Target.Row, "O").Value <> "" Or _
Cells(Target.Row, "O").Value <> "" And AscW(Target.Value & " ") = 10006 Then

I don't think you need both lines as you are using AND

If AscW(Target.Value & " ") = 10006 AND Cells(Target.Row, "O").Value <> "" Then but both have to be TRUE to make it run
 
Upvote 0
see red typing
so what do i do with this if i want to add
and if Cells(Target.Row, "G").Value <> ""

VBA Code: 
Private Sub Macro2(ByVal Target As Range)

    Dim svcMonth As Date
    Dim bDate As Date
    Dim sAge As Long
    svcMonth = Cells(Target.Row, "C")
    If Target.Column = 5 And Target.Cells.Count = 1 Then 'choose service?
        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
[COLOR=rgb(184, 49, 47)]i want to add it here[/COLOR]
            bDate = Cells(Target.Row, "R")
            sAge = DateDiff("yyyy", bDate, svcMonth)
            If sAge < 18 Then
                Cells(Target.Row, "O") = "Special Approval Needed"
 
Last edited by a moderator:
Upvote 0
whats wrong? it doesnt work both ways
i need that if target 13 has the AscW(Target.Value & " ") = 10006 and column o is not blank
or if column o is not blank and m is AscW(Target.Value & " ") = 10006

this is the "broken" part of my formula
If Target.Column = 13 And Target.Cells.Count = 1 Then
If Cells(Target.Row, "B").Value <> "" Then
If AscW(Target.Value & " ") = 10006 And Cells(Target.Row, "O").Value <> "" Or _
Target.Offset(0, 2).Value <> "" And AscW(Target.Value & " ") = 10006 Then
 
Upvote 0
SO what does Target.Value actually return, and did it ever equal "10006 ", i'm unclear about the SPACE

Target.Offset(0, 2).Value <> "" didn't exist in #1 above
 
Upvote 0
please help me
i am trying to be more ambitious than i know how. i learn and then try to do it but sometimes i mess up. i need each code to work themselves in reverse

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Macro1 Target      'event runs when cell in Column F or column G is changed
    Macro2 Target      'event runs when cell in Column E is changed
    Macro3 Target      'event runs when cell in Column M is changed
End Sub


Private Sub Macro1(ByVal Target As Range)

If Target.Cells.Count = 1 Then


If Cells(Target.Row, "B").Value <> "" And Cells(Target.Row, "F").Value = "_Approvals Missing" And Cells(Target.Row, "G").Value <> "" Or _
Cells(Target.Row, "G").Value <> "" And Cells(Target.Row, "F").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 ("[EMAIL]mail@mail.org[/EMAIL]") ' Add Recipients
            newmsg.Subject = Cells(Target.Row, "B").Value & "Missing Approval"  ' Add Subject
            newmsg.Body = "Missing Approval" & vbCrLf & "" & _
                          "Please get approval for   " & _
                          Cells(Target.Row, "B").Value & _
                          " for Missing Class/Membership:   " & _
                          Cells(Target.Row, "G").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, "C")
    If Target.Column = 5 And Target.Cells.Count = 1 Then 'choose service?
        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, "R")
            sAge = DateDiff("yyyy", bDate, svcMonth)
            If sAge < 18 Then
                Cells(Target.Row, "O") = "Special Approval Needed"
              
                If Cells(Target.Row, "O") = "Special Approval Needed" Then

        result = MsgBox("Is there a special approval for age override?", vbOKOnly + vbExclamation)
      
        If result = vbOK Then

            Set OutlookApp = CreateObject("Outlook.Application")
            Set OlObjects = OutlookApp.GetNamespace("MAPI")
            Set newmsg = OutlookApp.CreateItem(olMailItem)

            newmsg.Recipients.Add ("[EMAIL]mail@mail.org[/EMAIL]") ' Add Recipients
            newmsg.Subject = Cells(Target.Row, "B").Value & "Special AgeOverride Needed"  ' Add Subject
            newmsg.Body = "This is a reminder to obtain or verify that  " & vbCrLf & "" & _
                          Cells(Target.Row, "B").Value & "   needs an age override for   " & _
                          Cells(Target.Row, "C").Value & "   for     " & _
                          Cells(Target.Row, "E").Value & "   " & " " & _
                          Cells(Target.Row, "G").Value & "   as this is usually an inelligble service for under 18 "  '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 If
    End If
End Sub


Private Sub Macro3(ByVal Target As Range)

Dim Submission As String
Submission = Cells(Target.Row, "M")

If Target.Column = 13 And Target.Cells.Count = 1 Then
If Cells(Target.Row, "B").Value <> "" Then

If AscW(Target.Value & " ") = 10006 And Cells(Target.Row, "O").Value <> "" Or _
Cells(Target.Row, "O").Value <> "" And AscW(Target.Value & " ") = 10006 Then

     
        result = MsgBox("pressing OK will send email reminder", 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 ("[EMAIL]mail@mail.org[/EMAIL]") ' Add Recipients
            newmsg.Subject = Cells(Target.Row, "B").Value & "Submitted Incorrectly"  ' Add Subject
            newmsg.Body = "This is a reminder to inform" & vbCrLf & "" & _
                          "Broker/Mom that   " & _
                          Cells(Target.Row, "B").Value & "   for" & _
                          Cells(Target.Row, "C").Value & "   for" & _
                          Cells(Target.Row, "F").Value & "   " & " " & _
                          Cells(Target.Row, "G").Value & "  " & " " & _
                          Cells(Target.Row, "O").Value & "   as per X on grid"  '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 If
End Sub
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
How to write time in coding
Replies
5
Views
311
Peter_SSs
Peter_SSs
H
  • Question
Macro to attached sheets without formulas
Replies
2
Views
383
howard
H
R
  • Question
email status
Replies
6
Views
460
Logit
Logit
R
  • Question
userform errors
2
Replies
13
Views
582
rjmdc
R
S
  • Solved
Calling new Subs
Replies
2
Views
460
Saeva
S

Forum statistics

Threads
1,214,914
Messages
6,122,211
Members
449,074
Latest member
cancansova

Share this page

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