visual basic formula

I

ineedadedt

Board Regular
Joined
Jan 7, 2004
Messages
163
Hi everyone, I need some help with a formula. When I click on the macro it works, but not to what I was looking for. I am by no means a programmer and I probably have code in their that doesn't need to be. However, I have it working very close to what I need and think this forum will be able to solve it in 5 minutes.

Here is the situation:
B1-J1 are the fields that I need in every email.
A1 is a name field
B-J have test scores.
I have the macro run to pull a name from A2-50 ( a name) and then pull their scores (B-J) for their corresponding cell.

example
A1 b1 C1 -------J
NAME TEST Test2
Eric 90 90

The email will send it to A1-Eric and then put the scores in the body.
My problem is that I do not have B1-J1 lined up with the test scores. Everything runs vertical and I need it to either run horizontal or run both vertical next to each other.

Hopefully this isnt too confusing. Below is the code I have.

Thanks for all the help in advance!!

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, url As String
Dim Vin As String
Dim r As Integer, x As Double
For r = 2 To 2 'data in rows 2-51
' Get the email address
Email = Cells(r, 1)

' Message subject
Subj = "Your training grades"

Dim cell As Range
Dim strbody As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("B1:J1")
strbody = strbody & cell.Value & vbNewLine

Dim cell2 As Range
Dim grades As String
For Each cell2 In ThisWorkbook.Sheets("Sheet1").Range("B2:J2")
grades = grades & cell.Value & vbNewLine

Next
Next




' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "Below are your grades for training." & vbCrLf & vbCrLf
'Msg = Msg & Cells(V.Text & ", "
'Msg = Msg & Cells(v, c).Text & ", "
'Msg = Msg & Cells(v, d).Text & ", "
'Msg = Msg & Cells(r, 5).Text & ", "
'Msg = Msg & Cells(r, 6).Text & ", "
'Msg = Msg & Cells(r, 7).Text & ", "
'Msg = Msg & Cells(r, 8).Text & ", "
Msg = Msg & strbody & ", "
Msg = Msg & grades & ", "
Msg = Msg & Cells(r, 2).Text & ", "
Msg = Msg & Cells(r, 3).Text & ", "
Msg = Msg & Cells(r, 4).Text & ", "
Msg = Msg & Cells(r, 5).Text & ", "
Msg = Msg & Cells(r, 6).Text & ", "
Msg = Msg & Cells(r, 7).Text & ", "
Msg = Msg & Cells(r, 8).Text & ", "
Msg = Msg & Cells(r, 9).Text & ", " & vbCrLf
Msg = Msg & Cells(r, 10).Text & ", "
Msg = Msg & Cells(r, 11).Text & vbCrLf
Msg = Msg & "Eric Duchin" & vbCrLf
Msg = Msg & ""

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
' Create the URL
url = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, url, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next
End Sub
:banghead:
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
Your tally variable is line-feeding after every cell value:
grades = grades & cell.Value & vbNewLine

Try: grades = grades & cell.Value & " , "

Yours gives:
98
77
54
88...

The new one gives: 98 , 77 , 54 , 88

as output to the e-mail.
 
Upvote 0
Thank you for the help! I am now one step closer to getting it. The output is still a little screwy. It still puts up this. But a little closer for me.

"Below are your grades for training.

Research Paper
Test 1
Test 2
Test 3
Final
Participation
Attendance
Final Grade
Comments
, Research Paper , Research Paper , Research Paper , Research Paper , Research Paper , Research Paper , Research Paper , Research Paper , Research Paper , Test 1 , Test 1 , Test 1 , Test 1 , Test 1 , Test 1 , Test 1 , Test 1 , Test 1 , Test 2 , Test 2 , Test 2 , Test 2 , Test 2 , Test 2 , Test 2 , Test 2 , Test 2 , Test 3 , Test 3 , Test 3 , Test 3 , Test 3 , Test 3 , Test 3 , Test 3 , Test 3 , Final , Final , Final , Final , Final , Final , Final , Final , Final , Participation , Participation , Participation , Participation , Participation , Participation , Participation , Participation , Participation , Attendance , Attendance , Attendance , Attendance , Attendance , Attendance , Attendance , Attendance , Attendance , Final Grade , Final Grade , Final Grade , Final Grade , Final Grade , Final Grade , Final Grade , Final Grade , Final Grade , Comments , Comments , Comments , Comments , Comments , Comments , Comments , Comments , Comments , , 95, 93, 80.75, , , 100, 100, 60.6,
test one, "

Any other suggestions to get me a little closer?

:hungry:
 
Upvote 0
I am even one step closer now. I have everything going horizontal, which is what I want. However, I need to get rid of the line being repeated 9 times. Any help on that?

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, url As String
Dim Vin As String
Dim r As Integer, x As Double
For r = 2 To 2 'data in rows 2-51
' Get the email address
Email = Cells(r, 1)

' Message subject
Subj = "Your training grades"

Dim cell As Range
Dim strbody As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("B1:J1")
strbody = strbody & cell.Value & " , "

Dim cell2 As Range
Dim grades As String
For Each cell2 In ThisWorkbook.Sheets("Sheet1").Range("B2:J2")
grades = grades & cell.Value & " , "

Next
Next




' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "Below are your grades for training." & vbCrLf & vbCrLf

Msg = Msg & strbody & ", "
Msg = Msg & grades & ", "
Msg = Msg & Cells(r, 2).Text & ", "
Msg = Msg & Cells(r, 3).Text & ", "
Msg = Msg & Cells(r, 4).Text & ", "
Msg = Msg & Cells(r, 5).Text & ", "
Msg = Msg & Cells(r, 6).Text & ", "
Msg = Msg & Cells(r, 7).Text & ", "
Msg = Msg & Cells(r, 8).Text & ", "
Msg = Msg & Cells(r, 9).Text & ", " & vbCrLf
Msg = Msg & Cells(r, 10).Text & ", "
Msg = Msg & Cells(r, 11).Text & vbCrLf
Msg = Msg & "Eric Duchin" & vbCrLf
Msg = Msg & ""

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
' Create the URL
url = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, url, vbNullString, vbNullString, vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next
End Sub
 
Upvote 0
Replace your MsgBox Block with this one:

' Compose the message
Msg = ""
Msg = "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf _
& "Below are your grades for training." & vbCrLf & vbCrLf _
& strbody & ", " & grades & ", " & Cells(r, 2).Text & ", " _
& Cells(r, 3).Text & ", " & Cells(r, 4).Text & ", " _
& Cells(r, 5).Text & ", " & Cells(r, 6).Text & ", " _
& Cells(r, 7).Text & ", " & Cells(r, 8).Text & ", " _
& Cells(r, 9).Text & ", " & vbCrLf & Cells(r, 10).Text & ", " _
& Cells(r, 11).Text & vbCrLf & "Eric Duchin"

Your MsgBox was adding all the data from all the other line to each new line of your Message statement. I cancantanate all your data into one statement Above!
 
Upvote 0
Thank you for responding Joe. I tried to replace it with your formula but nothing happened. I am not sure what I did wrong.

Eroc
 
Upvote 0
surely someone can come up with a copy/ paste formula to use , i fyou just copy the cells in excel and paste them into outlook would they be in the right position?

chad
 
Upvote 0
I tested the Msg code with the Sub below. It is a test of the message only and does not have the code to send the e-mail!

It worked for me!

Sub Test()
Dim Email As String, Subj As String
Dim Msg As String, url As String
Dim Vin As String
Dim r As Integer, x As Double
For r = 2 To 2 'data in rows 2-51
' Get the email address
Email = Cells(r, 1)

' Message subject
Subj = "Your training grades"

Dim cell As Range
Dim strbody As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("B1:J1")
strbody = strbody & cell.Value & " , "

Dim cell2 As Range
Dim grades As String
For Each cell2 In ThisWorkbook.Sheets("Sheet1").Range("B2:J2")
grades = grades & cell.Value & " , "

Next
Next


' Compose the message
Range("A1").Select
Msg = ""
Msg = "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf _
& "Below are your grades for training." & vbCrLf & vbCrLf _
& strbody & ", " & grades & ", " & Cells(r, 2).Text & ", " _
& Cells(r, 3).Text & ", " & Cells(r, 4).Text & ", " _
& Cells(r, 5).Text & ", " & Cells(r, 6).Text & ", " _
& Cells(r, 7).Text & ", " & Cells(r, 8).Text & ", " _
& Cells(r, 9).Text & ", " & vbCrLf & Cells(r, 10).Text & ", " _
& Cells(r, 11).Text & vbCrLf & "Eric Duchin"

MsgBox Subj & Chr(13) & Msg

Next

End Sub
 
Upvote 0
The code did work, but now I am getting multiple research papers, as well as tests, etc. Unfortunately they do not match up either..I think im going to work on a different solution to this problem. Thank you all so much. I love coming to this board and I tell everyone about it.

Thanks again,
:beerchug:
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
SENDING BULK EMAILS FROM EXCEL VBA IN ONE CLICK/ WITH PARTICULAR PULL ID TO USE
Replies
1
Views
2K
DanteAmor
DanteAmor
M
  • Question Question
VBA Msgbox with clickable URL
Replies
1
Views
114
dreid1011
dreid1011
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
227
ipbr21054
I
A
  • Question Question
Procedure works in one workbook but not another
Replies
3
Views
123
AlexanderBB
A
M
  • Solved
Help to exit VBA upon cancel on input box
Replies
3
Views
585
Domenic
D

Forum statistics

Threads
1,225,229
Messages
6,183,731
Members
453,186
Latest member
CM_1995

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