If then VBA

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
 

drubin25

Board Regular
Joined
Mar 19, 2016
Messages
62
This is awesome! THANK YOU. A couple of questions:

1. If D26 = "SEND TO OFFICE TO CREATE A BACKORDER." how do I get it to send an email to someone with the following:

SUBJECT LINE- "BACKORDER REQUIRED FOR (input tab/cell G4)
BODY OF EMAIL- "A backorder is required for (input tab/cell G4), Qty: (input tab/cell M4), PO# (input tab/cell G20)"

2. How do I get MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX." once the record has been pasted into the "Records" tab?

Again, this is so awesome. Thank you.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,814
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
1) This deserves a separate thread that you can start.

2) You haven't mentioned what to save into the 'Records' sheet, or where to save it to into the 'Records'' sheet prior to displaying that MsgBox.

Assuming you are referring to this section of code:

VBA Code:
'
    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
'
        MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX."
    End If
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,814
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
If you want to display the "THE RECORD HAS BEEN SAVED" after the code that is below that point that pastes values into the other sheet, we can do that.

All I can do is work from the code that you have previously posted. I can't guess what you want.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,814
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
I guess that code would look something like:

VBA Code:
Sub test3()
'
''    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
        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
 

drubin25

Board Regular
Joined
Mar 19, 2016
Messages
62
I am stuggling with a "custom" auto email. Below is what I have so far (email section at the bottom) At the end of this code, I would like to automatically send an email ONLY IF [Input cell D26 = "SEND TO OFFICE TO CREATE A BACKORDER" . I would like the subject line to be the following:

"ACTION REQUIRED: ENTER A BACKORDER" [Input] tab cell G4 + "PO Number" [Input] tab cell G20

then I would like the body of the email to read:

Please create a backorder for the following:

Customer: [Input] tab cell G4
Customer #: [Input] tab cell M4
Quantity: [Input] tab cell R8
PO Number: [Input] tab cell G20

Contact for Questions: [Input] tab cell M14

Sub SENDTOLOG_Click()
'
'' 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
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

Sub Email()

Dim Email As Outlook.Application
Set Email = New Outlook.Application
Dim Sr As String
Dim newmail As Outlook.MailItem
Set newmail = Email.CreateItem(olMailItem)

newmail.To = "d@jw.com"
newmail.CC = "d@jw.com"
newmail.Subject = "ACTION REQUIRED: " & Sheets("Input").Range("G4").Value & "PO Number " & Range("G20")
newmail.HTMLBody = "Hi," & vbNewLine & vbNewLine & "This is a test email from Excel" & _
vbNewLine & vbNewLine & _
"Regards," & vbNewLine & _
"VBA Coder"
Sr = ThisWorkbook.FullName
newmail.Attachments.Add Sr
newmail.Send

End Sub
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,814
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
I am stuggling with a "custom" auto email. Below is what I have so far (email section at the bottom) At the end of this code, I would like to automatically send an email ONLY IF [Input cell D26 = "SEND TO OFFICE TO CREATE A BACKORDER" .
Where in the code would you like to check 'IF [Input cell D26 = "SEND TO OFFICE TO CREATE A BACKORDER"'?

At the end of the first sub that you posted or at the beginning of the email sub you posted?
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,814
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Without having that answer, I have to say I don't send emails this way, so the following code for the email section is untested and you would have to test it:

VBA Code:
Sub Email()
'
    Dim Email   As Outlook.Application
    Dim newmail As Outlook.MailItem
    Dim Sr      As String
'
      Set Email = New Outlook.Application
    Set newmail = Email.CreateItem(olMailItem)
'
          newmail.To = "d@jw.com"
          newmail.CC = "d@jw.com"
     newmail.Subject = "ACTION REQUIRED: ENTER A BACKORDER" & CS.Range("G4").Value & "PO Number " & CS.Range("G20")
'
    newmail.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
'
    Sr = ThisWorkbook.FullName
    newmail.Attachments.Add Sr
'
    newmail.Send
End Sub
 

drubin25

Board Regular
Joined
Mar 19, 2016
Messages
62
@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

'
I would like to somehow get an email to send automatically. What you have listed should work well, but what change do I need to make to my code to make this happen? Full code below:

Sub SENDTOLOG_Click()
'
'' 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
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
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,814
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Without looking back over the code, I am guessing you would want to add the following line to that section in red you posted:

VBA Code:
    Call Email
 

Forum statistics

Threads
1,175,982
Messages
5,900,703
Members
434,845
Latest member
rowell123

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
Top