If then VBA

D

drubin25

Board Regular
Joined
Mar 19, 2016
Messages
62
I am having difficulty creating the code that if a certain condition is not met, it cycles to the next. The code is orange works great, but I need it to do the following afterwards if the next condition is not met:

IF D26 = "DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER.", then a message box pops up saying, ""DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER. NOTHING IS REQUIRED OF YOU FOR THIS ITEM."

If that condition is not met and D26 = "SEND TO OFFICE TO CREATE A BACKORDER.", then a message box pops up saying, "THE RULES FOR THIS CUSTOMER REQUIRE THE FRONT OFFICE TO CREATE A BACKORDER. DO NOT ENTER A SPECIAL BATCH. THE FRONT OFFICE HAS BEEN NOTIFIED, AND NOTHING FURTHER IS REQUIRED." Also, if this condition is met, I would like it to send an email to someone saying, "A BACKORDER IS REQUIRED FOR [input worskeet cell G4], QTY [input worskeet cell M7], PO NUMBER [input worskeet cell G20].

Once all of these are done, I would like the MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX." to pop up.

I currently have the following:

Sub SENDTOLOG_Click()
Application.ScreenUpdating = False
Dim CS As Worksheet, PS As Worksheet, lr As Long, M As Long

Set CS = Worksheets("Input")
Set PS = Worksheets("Records")

If Range("G4") = "" Then
MsgBox "Please enter the CUSTOMER NAME" & vbCrLf & " " & vbCrLf & "XXXXXXX"
ElseIf Range("G7") = "" Then
MsgBox "Please enter the LINE QUANTITY" & vbCrLf & " " & vbCrLf & "XXXXXXX"
ElseIf Range("M7") = "" Then
MsgBox "Please enter the QTY REJECTED" & vbCrLf & " " & vbCrLf & "XXXXXXX"
ElseIf Range("G14") = "" Then
MsgBox "Please enter the TICKET LOAD DATE" & vbCrLf & " " & vbCrLf & "XXXXXXX"
ElseIf Range("M14") = "" Then
MsgBox "Please enter your name in the REJECTED BY: BOX" & vbCrLf & " " & vbCrLf & "XXXXXXX"
ElseIf Range("G20") = "" Then
MsgBox "Please enter the PO NUMBER" & vbCrLf & " " & vbCrLf & "XXXXXXX"
ElseIf Worksheets("Input").Range("D26").Value = "CREATE SPECIAL BATCH" Then
MsgBox ("YOU MUST CREATE A SPECIAL BATCH")
sText = Application.InputBox("ENTER THE SPECIAL BATCH TICKET NUMBER THAT WAS CREATED: " & vbCrLf & "XXXXXXX:")

MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX."
'Sheets("Input").Activate
'Application.ScreenUpdating = True

'Find First Empty Row after Data
lr = PS.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copy data from the INPUT to the RECORDS worksheet

'copy CUSTOMER #
PS.Cells(lr, 1).Value = CS.Range("M4").Value
'copy CUSTOMER NAME
PS.Cells(lr, 2).Value = CS.Range("G4").Value
'copy ENTRY DATE/TIME
PS.Cells(lr, 3).Value = CS.Range("D17").Value
'copy TICKET LOAD DATE
PS.Cells(lr, 4).Value = CS.Range("G14").Value
'copy LINE QTY
PS.Cells(lr, 5).Value = CS.Range("G7").Value
'copy QTY REJECTED
PS.Cells(lr, 6).Value = CS.Range("M7").Value
'copy % REJECTED
PS.Cells(lr, 7).Value = CS.Range("P7").Value
'copy RULE
PS.Cells(lr, 8).Value = CS.Range("G11").Value
'copy RESPONSE
PS.Cells(lr, 9).Value = CS.Range("D26").Value
'copy rejected by:
PS.Cells(lr, 10).Value = CS.Range("M14").Value
'copy before 2pm:
PS.Cells(lr, 11).Value = CS.Range("S24").Value
'copy load date after today?:
PS.Cells(lr, 12).Value = CS.Range("T24").Value
'copy PO start w/ number?:
PS.Cells(lr, 13).Value = CS.Range("U24").Value
'copy less than 10 rejected?:
PS.Cells(lr, 14).Value = CS.Range("V24").Value
'copy 5 or less rejected?:
PS.Cells(lr, 15).Value = CS.Range("X24").Value
'copy less than % rule?:
PS.Cells(lr, 16).Value = CS.Range("Y24").Value

End Sub
 
Sort by date Sort by votes
drubin25 said:
@johnnyL thank you for your help! If this is triggered:

If CS.Range("D26").Value = "SEND TO OFFICE TO CREATE A BACKORDER." Then
lr = PS.Range("A" & PS.Rows.Count).End(xlUp).Row + 1 ' Find First Empty Row after Data
'
' You didn't mention what to do here with the lr
'
Click to expand...

/\ /\ /\ /\ /\ /\ /\ /\ I meant the section in red literally. :)
 
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
@johnnyL Getting closer....I replaced the section in red with "Call Email", then I get an error of "Object Required". I have already adjusted the Sub Email. See below...

If CS.Range("D26").Value = "DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER." Then
MsgBox ("DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER. NOTHING IS REQUIRED OF YOU FOR THIS ITEM.")
End If

Call Email

'
'
'End If
'
lr = PS.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Find First Empty Row after Data
'
' Copy data from the INPUT to the RECORDS worksheet
ArSourceAddress = Array("M4", "G4", "D17", "G14", "G7", "M7", "P7", "G11", "D26", "M14")
'
For I = 0 To UBound(ArSourceAddress)
PS.Cells(lr, I + 1).Value = CS.Range(ArSourceAddress(I)).Value ' Columns 1 thru 10 .... Array addresses
Next
'
PS.Cells(lr, 11).Resize(, 4).Value = CS.Range("S24").Resize(, 4).Value 'Columns 11,12,13,14 .... S24,T24,U24,V24
'
PS.Cells(lr, 15).Resize(, 2).Value = CS.Range("X24").Resize(, 2).Value ' Columns 15,16 .... X24,Y24
'
MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX."


''Application.ScreenUpdating = True

'End If
End Sub

Sub Email()

Dim OutlookApp As Object
Dim OutlookMail As Object

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
.To = "drubin@jeldwen.com"
.CC = "drubin@jeldwen.com"
.BCC = "drubin@jeldwen.com"
.Subject = "ACTION REQUIRED: ENTER A BACKORDER" & CS.Range("G4").Value & "PO Number " & CS.Range("G20")
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Please create a backorder for the following:" & vbNewLine & vbNewLine & "Customer: " & CS.Range("G4").Value & vbNewLine & _
"Customer #: " & CS.Range("M4").Value & vbNewLine & "Quantity: " & CS.Range("R8").Value & vbNewLine & "PO Number: " & CS.Range("G20").Value & _
vbNewLine & vbNewLine & "Contact for Questions: " & CS.Range("M14").Value
.Importance = 2
.Send
End With

SetoutlookMail = Nothing
Set OutlookApp = Nothing

End Sub
 
Upvote 0
@drubin25 It is very hard to follow what you are doing when you don't use code tags around your code. Please notice, at the top of the respond box, there are icons across the top of it. When you want to post code, please Enter a new line and then select the icon that has 'VBA' at the bottom of the icon. That will display "CODE=vba][/CODE]". Paste your code in the middle of the two inner brackets ']['. That will make your code easier to sift through.

That being said, I feel you are straying off course to my suggestions, such as what to do with the last one to insert a call to the Email sub routine.

Going off of my previous code concerning this section of code I will paste it including the call to the Email sub routine.

VBA Code: 
Sub test3_5()
'
''    Application.ScreenUpdating = False
'
    Dim CS As Worksheet, PS As Worksheet, lr As Long        ' , M As Long
    Dim LineQuantity        As Long
    Dim QtyRejected         As Long
    Dim TicketLoadDate      As String
    Dim ArSourceAddress()   As Variant
    Dim CustName            As Variant
    Dim POnumber            As Variant
    Dim RejectedBy          As Variant
    Dim SpecialBatchNumber  As Variant
'
    Set CS = Worksheets("Input")
    Set PS = Worksheets("Records")
'
    If CS.Range("G4") = "" Then
        Do
            CustName = Application.InputBox(Prompt:="Please enter the CUSTOMER NAME" & vbCrLf & " " & vbCrLf & "XXXXXXX")  ' Text entry
        Loop Until CustName <> vbNullString And CustName <> False
'
        CS.Range("G4").Value = CustName
    End If
'
    If CS.Range("G7") = "" Then
        Do
            LineQuantity = Application.InputBox(Prompt:="Please enter the LINE QUANTITY" & vbCrLf & " " & vbCrLf & "XXXXXXX", Type:=1)  ' Numeric Entry
        Loop Until LineQuantity <> 0 And LineQuantity <> False
'
        CS.Range("G7").Value = LineQuantity
    End If
'
    If CS.Range("M7") = "" Then
        Do
            QtyRejected = Application.InputBox(Prompt:="Please enter the QTY REJECTED" & vbCrLf & " " & vbCrLf & "XXXXXXX", Type:=1)    ' Numeric Entry
        Loop Until QtyRejected <> 0 And QtyRejected <> False
'
        CS.Range("M7").Value = QtyRejected
    End If
'
    If CS.Range("G14") = "" Then
        Do
            TicketLoadDate = Application.InputBox(Prompt:="Please enter the TICKET LOAD DATE" & vbCrLf & " " & vbCrLf & "XXXXXXX")      ' Date Entry
        Loop Until IsDate(TicketLoadDate) = True
'
        CS.Range("G14").Value = TicketLoadDate
    End If
'
    If CS.Range("M14") = "" Then
        Do
            RejectedBy = Application.InputBox(Prompt:="Please enter your name in the REJECTED BY: BOX" & vbCrLf & " " & vbCrLf & "XXXXXXX") ' Text entry
        Loop Until RejectedBy <> vbNullString And RejectedBy <> False
'
        CS.Range("M14").Value = RejectedBy
    End If
'
    If CS.Range("G20") = "" Then
        Do
            POnumber = Application.InputBox(Prompt:="Please enter the PO NUMBER" & vbCrLf & " " & vbCrLf & "XXXXXXX")  ' Text entry
        Loop Until POnumber <> vbNullString And POnumber <> False
'
        CS.Range("G20").Value = POnumber
    End If
'
    If CS.Range("D26").Value = "CREATE SPECIAL BATCH" Then
        MsgBox ("YOU MUST CREATE A SPECIAL BATCH")
'
        Do
            SpecialBatchNumber = Application.InputBox(Prompt:="ENTER THE SPECIAL BATCH TICKET NUMBER THAT WAS CREATED: " & vbCrLf & "XXXXXXX:") ' Text entry
        Loop Until SpecialBatchNumber <> vbNullString And SpecialBatchNumber <> False
'
        lr = PS.Range("A" & PS.Rows.Count).End(xlUp).Row + 1            ' Find First Empty Row after Data

        PS.Range("Q" & lr).Value = SpecialBatchNumber
    End If
'
    If CS.Range("D26").Value = "DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER." Then
        MsgBox ("DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER. NOTHING IS REQUIRED OF YOU FOR THIS ITEM.")
    End If
'
    If CS.Range("D26").Value = "SEND TO OFFICE TO CREATE A BACKORDER." Then
'
        Call Email                                                                                                  ' <--- This was inserted ***
'
        lr = PS.Range("A" & PS.Rows.Count).End(xlUp).Row + 1            ' Find First Empty Row after Data
'
'       You didn't mention what to do here with the lr
'
    End If
'
    lr = PS.Cells(Rows.Count, 1).End(xlUp).Row + 1                  ' Find First Empty Row after Data
'
'   Copy data from the INPUT to the RECORDS worksheet
    ArSourceAddress = Array("M4", "G4", "D17", "G14", "G7", "M7", "P7", "G11", "D26", "M14")
'
    For I = 0 To UBound(ArSourceAddress)
        PS.Cells(lr, I + 1).Value = CS.Range(ArSourceAddress(I)).Value           ' Columns 1 thru 10 .... Array addresses
    Next
'
    PS.Cells(lr, 11).Resize(, 4).Value = CS.Range("S24").Resize(, 4).Value  'Columns 11,12,13,14 .... S24,T24,U24,V24
'
    PS.Cells(lr, 15).Resize(, 2).Value = CS.Range("X24").Resize(, 2).Value  ' Columns 15,16 .... X24,Y24
'
    MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX."

''Application.ScreenUpdating = True
End Sub
 
Upvote 0
johnnyL said:
@drubin25 It is very hard to follow what you are doing when you don't use code tags around your code. Please notice, at the top of the respond box, there are icons across the top of it. When you want to post code, please Enter a new line and then select the icon that has 'VBA' at the bottom of the icon. That will display "CODE=vba][/CODE]". Paste your code in the middle of the two inner brackets ']['. That will make your code easier to sift through.

That being said, I feel you are straying off course to my suggestions, such as what to do with the last one to insert a call to the Email sub routine.

Going off of my previous code concerning this section of code I will paste it including the call to the Email sub routine.

VBA Code: 
Sub test3_5()
'
''    Application.ScreenUpdating = False
'
    Dim CS As Worksheet, PS As Worksheet, lr As Long        ' , M As Long
    Dim LineQuantity        As Long
    Dim QtyRejected         As Long
    Dim TicketLoadDate      As String
    Dim ArSourceAddress()   As Variant
    Dim CustName            As Variant
    Dim POnumber            As Variant
    Dim RejectedBy          As Variant
    Dim SpecialBatchNumber  As Variant
'
    Set CS = Worksheets("Input")
    Set PS = Worksheets("Records")
'
    If CS.Range("G4") = "" Then
        Do
            CustName = Application.InputBox(Prompt:="Please enter the CUSTOMER NAME" & vbCrLf & " " & vbCrLf & "XXXXXXX")  ' Text entry
        Loop Until CustName <> vbNullString And CustName <> False
'
        CS.Range("G4").Value = CustName
    End If
'
    If CS.Range("G7") = "" Then
        Do
            LineQuantity = Application.InputBox(Prompt:="Please enter the LINE QUANTITY" & vbCrLf & " " & vbCrLf & "XXXXXXX", Type:=1)  ' Numeric Entry
        Loop Until LineQuantity <> 0 And LineQuantity <> False
'
        CS.Range("G7").Value = LineQuantity
    End If
'
    If CS.Range("M7") = "" Then
        Do
            QtyRejected = Application.InputBox(Prompt:="Please enter the QTY REJECTED" & vbCrLf & " " & vbCrLf & "XXXXXXX", Type:=1)    ' Numeric Entry
        Loop Until QtyRejected <> 0 And QtyRejected <> False
'
        CS.Range("M7").Value = QtyRejected
    End If
'
    If CS.Range("G14") = "" Then
        Do
            TicketLoadDate = Application.InputBox(Prompt:="Please enter the TICKET LOAD DATE" & vbCrLf & " " & vbCrLf & "XXXXXXX")      ' Date Entry
        Loop Until IsDate(TicketLoadDate) = True
'
        CS.Range("G14").Value = TicketLoadDate
    End If
'
    If CS.Range("M14") = "" Then
        Do
            RejectedBy = Application.InputBox(Prompt:="Please enter your name in the REJECTED BY: BOX" & vbCrLf & " " & vbCrLf & "XXXXXXX") ' Text entry
        Loop Until RejectedBy <> vbNullString And RejectedBy <> False
'
        CS.Range("M14").Value = RejectedBy
    End If
'
    If CS.Range("G20") = "" Then
        Do
            POnumber = Application.InputBox(Prompt:="Please enter the PO NUMBER" & vbCrLf & " " & vbCrLf & "XXXXXXX")  ' Text entry
        Loop Until POnumber <> vbNullString And POnumber <> False
'
        CS.Range("G20").Value = POnumber
    End If
'
    If CS.Range("D26").Value = "CREATE SPECIAL BATCH" Then
        MsgBox ("YOU MUST CREATE A SPECIAL BATCH")
'
        Do
            SpecialBatchNumber = Application.InputBox(Prompt:="ENTER THE SPECIAL BATCH TICKET NUMBER THAT WAS CREATED: " & vbCrLf & "XXXXXXX:") ' Text entry
        Loop Until SpecialBatchNumber <> vbNullString And SpecialBatchNumber <> False
'
        lr = PS.Range("A" & PS.Rows.Count).End(xlUp).Row + 1            ' Find First Empty Row after Data

        PS.Range("Q" & lr).Value = SpecialBatchNumber
    End If
'
    If CS.Range("D26").Value = "DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER." Then
        MsgBox ("DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER. NOTHING IS REQUIRED OF YOU FOR THIS ITEM.")
    End If
'
    If CS.Range("D26").Value = "SEND TO OFFICE TO CREATE A BACKORDER." Then
'
        Call Email                                                                                                  ' <--- This was inserted ***
'
        lr = PS.Range("A" & PS.Rows.Count).End(xlUp).Row + 1            ' Find First Empty Row after Data
'
'       You didn't mention what to do here with the lr
'
    End If
'
    lr = PS.Cells(Rows.Count, 1).End(xlUp).Row + 1                  ' Find First Empty Row after Data
'
'   Copy data from the INPUT to the RECORDS worksheet
    ArSourceAddress = Array("M4", "G4", "D17", "G14", "G7", "M7", "P7", "G11", "D26", "M14")
'
    For I = 0 To UBound(ArSourceAddress)
        PS.Cells(lr, I + 1).Value = CS.Range(ArSourceAddress(I)).Value           ' Columns 1 thru 10 .... Array addresses
    Next
'
    PS.Cells(lr, 11).Resize(, 4).Value = CS.Range("S24").Resize(, 4).Value  'Columns 11,12,13,14 .... S24,T24,U24,V24
'
    PS.Cells(lr, 15).Resize(, 2).Value = CS.Range("X24").Resize(, 2).Value  ' Columns 15,16 .... X24,Y24
'
    MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX."

''Application.ScreenUpdating = True
End Sub
Click to expand...
@johnnyL this fixed the problem (thank you), but it does not send an email. I'm not sure what I am missing.

VBA Code: 
Sub Email()

  Dim OutlookApp As Object
  Dim OutlookMail As Object

  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
    .To = "drubin@jeldwen.com"
    .CC = "drubin@jeldwen.com"
    .BCC = "drubin@jeldwen.com"
    .Subject = "ACTION REQUIRED: ENTER A BACKORDER" & CS.Range("G4").Value & "PO Number " & CS.Range("G20")
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "Please create a backorder for the following:" & vbNewLine & vbNewLine & "Customer: " & CS.Range("G4").Value & vbNewLine & _
        "Customer #: " & CS.Range("M4").Value & vbNewLine & "Quantity: " & CS.Range("R8").Value & vbNewLine & "PO Number: " & CS.Range("G20").Value & _
        vbNewLine & vbNewLine & "Contact for Questions: " & CS.Range("M14").Value
        .Importance = 2
        .Send
End With

SetoutlookMail = Nothing
Set OutlookApp = Nothing

End Sub
 
Upvote 0
Like I said earlier, I don't send email this way so I will probably not be much help in that area.

Did you try the Sub Email Subroutine from post #27?

After you try that, if you have everything else working except for the auto send, I would highly suggest you open a new thread asking how to auto send an email. ;)
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Send Email Automatically
Replies
3
Views
423
Logit
Logit
D
  • Question
conditional messages/email
Replies
0
Views
413
drubin25
D
D
  • Question
CALL EMAIL
Replies
5
Views
502
rollis13
rollis13
D
  • Question
Call Email Not Working
Replies
2
Views
426
Fluff
Fluff
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
321
sspatriots
S

Forum statistics

Threads
1,214,780
Messages
6,121,527
Members
449,037
Latest member
tmmotairi

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