Excel VBA - How can I send email with text specific to certain cell values?
Currently working on an order form in Excel and I'm stuck on sending an email via macro button.
Now I've seen online plenty of "how to send email using VBA in Excel" and I understand what they're on about.
My problem is I want the email body to display not only the main body of the email but I want to be able to put in a random numerical value a cell and the macro picks this up and dumps this cell value along with text specific to that cell.
For example the ordering form has 4 circuit boards I can order. For now these will be Represent by A, B, C & D
If I put 100 in each circuit board's quantity cell and click the Order button.
The following email would be as follows:
Dear <Name>
I'd like to order 100 of A, 100 of B, 100 of C & 100 of D
Kind Regards,
<Name>
Meanwhile if suddenly in the next order I want to place, I put only 20 in A & 60 in C, the email will change to reflect this change:
Dear <Name>
I'd like to order 20 of A & 60 of C
Kind Regards,
<Name>
These changes being the placement of comma's, fullstops and the et symbol '&'.
Anyone able to point me in the general direction of how I can do this/adapt current tutorials to get the result I require?
Edit: Seems there's a little misunderstanding in the form I'm on about so here's the current setup:
What I want to achieve via pressing the order button: Takes cell values from the amount column that corresponds to each individual board in the type column.
And takes those values into the main body of the email. In regards to the specific text such as commas etc. I was thinking more like a if statement format e.g. if B3 has value && B4 has a value but B5 and B6 == 0 then post in email body (B3)"(ref no)"+" & " + (B4)"(ref no)"
And so forth based whether or not any of those cells has a value in it. I'm not asking for text to be placed in other cells either such as cell J7 containing "I would like" etc.. that type of text I'll add directly onto the VBA script.
@BBRK - As regards to my comment on your answer this is what I mean by changing the message body:
xMailBody = "Hi <NAME>" & vbNewLine & vbNewLine & _
"I'd like to order" & vbNewLine & _
"Kind Regards"
On Error Resume Next
This code shows up as the following:
Realistically I wish to change the text being reference in Column A and replace that with hard-coded reference number which will correspond to orders I've made with the supplier.
Also I wish to change the positioning of the "0 of Vibro" and move that to after I've said I would like to order but not show up on the next line where it current is next to the "Kind Regards," section.
@BBRK here is current full VBA:
Private Sub Board_Order()
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B6" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
xMailBody = "Hi <NAME>" & vbNewLine & vbNewLine & _
"I'd like to order" & vbNewLine & _
"Kind Regards"
On Error Resume Next
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
xMailBody = xMailBody + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
xMailBody = xMailBody + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
xMailBody = xMailBody + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
xMailBody = xMailBody + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
End If
With xOutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Based on your explanation, I have developed a VBA method in Excel.
This will help you out to generate the concatenated string you want.
Copy and Paste below Excel VBA code in the editor and try to run it.
Sub Generate_String()
Dim HTML_body As String
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
HTML_body = "Hi <Name>," & vbnewline & vbnewline & "I'd like to order"
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
HTML_body = HTML_body + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
HTML_body = HTML_body + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
Else
HTML_body = "No Orders"
End If
HTML_body = HTML_body & vbnewline & "Kind Regards" & vbnewline & "<Name>"
With xOutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = HTML_body
.Display 'or use .Send
End With
End Sub
Modify it as per your need. Hope I was able to help you out.
I have edited the code as per your need. Problem was that you were adding 'Kind Regards' text before your processing.
EDIT2:
With validation checks if the amount column for any row is blank
Sub Generate_String()
Dim HTML_body As String
Dim count_var As Integer
Dim arr() As String
Dim arr_val() As Integer
Dim great_count As Integer
Dim arr_now As Integer
Dim rng_Body As Range
Dim xMailBody As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim validate_pass As Boolean
'Checks if the any of the range has blank values
'if blank value is found it will make validate_pass variable to false.
Set rng_Body = Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row)
validate_pass = True
For Each r In rng_Body
If Trim(r.Text) = "" Then
validate_pass = False
Exit For
End If
Next r
'If validate_pass variable is false then throws out error message.
'Else it will go through the normal procedure to sent out emails.
If validate_pass = False Then
MsgBox "Your appropriate error message if any of the amount value found blank", vbCritical
Else
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
arr_now = 0
Set rng_Body = Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row)
'Gets the count of number of zeroes available in the B3 to last data filled row of that column.
great_count = Application.WorksheetFunction.CountIf(Range("B3:B" & Range("B3").End(Excel.XlDirection.xlDown).Row), ">0")
HTML_body = "Hi <Name>," & vbNewLine & vbNewLine & "I'd like to order"
'If orders are there then will go for further processing.
If great_count <> 0 Then
'Resizes array according to the count
ReDim arr(0 To great_count - 1)
ReDim arr_val(0 To great_count - 1)
'Loops through the range and input product into the arr and it's value in arr_val
If great_count > 0 Then
For i = 3 To Range("B3").End(Excel.XlDirection.xlDown).Row
If Range("B" & i).Value > 0 Then
arr(arr_now) = Range("A" & i).Value
arr_val(arr_now) = Range("B" & i).Value
arr_now = arr_now + 1
End If
Next i
End If
'Looping through each element in the array to get the desired result.
If great_count = 1 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
Else
For j = 0 To UBound(arr)
If j = 0 Then
HTML_body = HTML_body + " " + CStr(arr_val(j)) + " of " + arr(j)
ElseIf j = UBound(arr) Then
HTML_body = HTML_body + " & " + CStr(arr_val(j)) + " of " + arr(j)
Else
HTML_body = HTML_body + " , " + CStr(arr_val(j)) + " of " + arr(j)
End If
Next j
End If
Else
HTML_body = "No Orders"
End If
HTML_body = HTML_body & vbNewLine & "Kind Regards" & vbNewLine & "<Name>"
With xOutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = HTML_body
.Display 'or use .Send
End With
MsgBox "Order Email has been Sent"
End If
End Sub
- How to make Colors Mixer in vba
- How to get HEX color value from cell color?
- SSIS: Insert multiple Excel files with same format but different file name to multiple database table destinations based on the Excel filename
- How to randomize Excel rows
- VLOOKUP Returns 0 even though there is a value in the line below the first result
- transpose a table with multiple values in excel
- Trying to late bind outlook to but getting type mismatch error after create object line
- Power Query Transform a Column based on Another Column
- Apply FILTER formula to array (and use filter criteria on specific column in the array)
- Bitly API call using VBA Excel Macro
- excel vba projects not closing
- In a standard MS Access SQL query output that does not have any aliases, how do I replace the full names by their "first-letters" aliases?
- Sigma or Summation function in Excel
- Problem getting the value from a cell using M in excel
- INDEX MATCH to also pull through notes
- Move formatted data in selection from Excel into Word tables
- Excel VBA function to remove letters at end of string
- Can't get all excel processes to stop when closing through Powershell
- Excel function to construct an array from values without VBA
- Alternative method to delete file with out having to add MS Scripting Runtime Reference
- Add new button to worksheet with Excel Add-in
- Apply outline border only to range of cells with openpyxl
- How to Separate Data with Inconsistent Patterns into a Structured Format in Excel
- Excel - Aggregate dynamically values in a Table using array formulas (MAP, BYROW, CHOOSECOLS, TEXTJOIN, LAMBDA, FILTER, HSTACK) in a single Cell
- How to reference the current User\Desktop location in VBA
- Powerpoint chart to excel relative link
- EXCEL: How do I return multiple columns using XLOOKUP, when the lookup_value is a range?
- VBA: How to Loop IF Statement through a Cell and Chart Series
- Incorporating Checkbox to lines of code rather than Cell value
- How do I remove a character from a column of data in Excel