visual basic formula

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
:oops:
 
The second next statement has an error in it, you forgot to change the Cell.Value to Cell2.Value. The correct one is:

For Each cell2 In ThisWorkbook.Sheets("Sheet1").Range("B2:J2")
grades = grades & cell2.Value & " , "
 
Upvote 0

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
I looked at a sample using your data.

If you re-design your data into a "Record" format rather than the muliti-line form you are using now you can avoid the "For-Next" problems you are having now.

Record form data is what you would use for database like operations. All the data for an individual "Student" is in you Sheet
as a one line record: Labels=Score or student name or other data. All on one row.

Cell A1: Student Bill Summers
Cell B1: Test1 =
Cell C1: 98
Cell D1: Test2 =
Cell E1: 74

and all your other data on the same row as "label cell then data cell"

Then you can do away with your For-Next structure and report your message as a cancantanation of strict cell values.

Msg = Cells(r, 1) & ", " & Cells(r, 2) & " " & Cells(r, 3) & ", " & Cells(r,4) & " " & Cells(r, 5) & "."

This will report:

Student Bill Sommers, Test1 = 98, Test2 = 74.

You can add any punctuation between cell values with the structure:
& "punctuation spaces text strings what ever" &
and add new lines with:
& Chr(13) &
for each new line you need.

If you set this up your Cells(r, C).Text structure can automatically send e-mails to all your students at once as each students record is only one "ROW" in your sheet.
 
Upvote 0
Try this as a test:

Sheet(1) Data:

.................A..................B...........C..............D...........E
1...Bill Sommers............Test 1 =....98..........Test 2 =....74
2...Marry Smith.............Test 1 =....88..........Test 2 =....82


Sheet Module:

Sub message()
Dim r As Integer
Dim Msg As String
Dim allMsgs As String

For r = 1 To 2

Msg = "Dear " & Cells(r, 1) & ":" & vbCrLf & vbCrLf _
& "Below are your grades for training:" & vbCrLf & vbCrLf _
& Cells(r, 2).Text & " " & Cells(r, 3).Text & ", " & _
Cells(r, 4).Text & " " & Cells(r, 5).Text & "." & Chr(13) & _
Chr(13) & "Eric Duchin."

MsgBox Msg
allMsgs = allMsgs & Chr(13) & Msg

Next

MsgBox allMsgs

End Sub
 
Upvote 0
Thank you very much Joe!! I like the way you have it and it will work so I will adopt it!! I can't say thank you enough especially because I have a minimum of 50 people to send it to each month.

Thanks again!! :pray:

Eric
 
Upvote 0
I mail editor for Outlook is set to MS Word. I just copied cells A1 to H50 on a sheet of mine and pasted into the body of the mail and its looked exactly like the spreadsheet.

Maybe you can change your mail editor to Word and change the code to use it instead of the outlook mail editor.
 
Upvote 0
Unfortunately for confidentiality I can not just mail everyone the worksheet. I would love to do that, but then they would see the other participants scores.

Nice try though! :biggrin:
 
Upvote 0

Forum statistics

Threads
1,216,081
Messages
6,128,696
Members
449,464
Latest member
againofsoul

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