ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   macro that uses data on diff. worksheet (https://www.excelbanter.com/excel-programming/337597-macro-uses-data-diff-worksheet.html)

periro16[_6_]

macro that uses data on diff. worksheet
 

hello I have the code below which orginally was being used only to work
off the current sheet. Now I have decided to put the macro button a
different worksheet. How do I set the the code so it uses the data on
"Datasheet"?
ie. for emails and msgs??
Many thanks!!

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


Code:
--------------------
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
Dim cell As Range

For r = 7 To 8 'data in rows 2-4

' Get the email address
Email = Cells(r, 2)

' Message subject
Subj = "Recruitment Activity Statement "

' Compose the message

Msg = vbCrLf
Msg = Msg & "Dear " & Cells(r, 3) & vbCrLf & vbCrLf

Msg = Msg & "Total Executive Interviews to date: " & Cells(r, 17) & vbCrLf & vbCrLf
Msg = Msg & "Your target for FY06: " & Sheets("Sheet1").Range("B1").Value & vbCrLf & vbCrLf
Msg = Msg & "Remaining to hit target: " & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "In order to achieve this you need to conduct "
Msg = Msg & Cells(r, 22) & " interviews each month." & vbCrLf & vbCrLf
Msg = Msg & "Your current Executive Interviewer rank: "
Msg = Msg & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "Msg from recruitment team - " & Cells(r, 1) & vbCrLf & vbCrLf & vbCrLf
Msg = Msg & "Thanks for your continued involvement! " & vbCrLf & vbCrLf
Msg = Msg & "The UKDC Recruitment Team"

' 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 r
End Sub
--------------------


--
periro16
------------------------------------------------------------------------
periro16's Profile: http://www.excelforum.com/member.php...o&userid=26345
View this thread: http://www.excelforum.com/showthread...hreadid=396763


Harald Staff

macro that uses data on diff. worksheet
 
Put the code in a standard module, not a sheet or workbook module. Replace
Cells(r,
with
Sheets("Datasheet").Cells(r,
and call or assign the macro from the button, depending what kind of button
it is.

HTH. Best wishes Harald

"periro16" skrev i
melding ...

hello I have the code below which orginally was being used only to work
off the current sheet. Now I have decided to put the macro button a
different worksheet. How do I set the the code so it uses the data on
"Datasheet"?
ie. for emails and msgs??
Many thanks!!

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


Code:
--------------------
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
Dim cell As Range

For r = 7 To 8 'data in rows 2-4

' Get the email address
Email = Cells(r, 2)

' Message subject
Subj = "Recruitment Activity Statement "

' Compose the message

Msg = vbCrLf
Msg = Msg & "Dear " & Cells(r, 3) & vbCrLf & vbCrLf

Msg = Msg & "Total Executive Interviews to date: " & Cells(r, 17) &

vbCrLf & vbCrLf
Msg = Msg & "Your target for FY06: " &

Sheets("Sheet1").Range("B1").Value & vbCrLf & vbCrLf
Msg = Msg & "Remaining to hit target: " & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "In order to achieve this you need to conduct "
Msg = Msg & Cells(r, 22) & " interviews each month." & vbCrLf & vbCrLf
Msg = Msg & "Your current Executive Interviewer rank: "
Msg = Msg & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "Msg from recruitment team - " & Cells(r, 1) & vbCrLf &

vbCrLf & vbCrLf
Msg = Msg & "Thanks for your continued involvement! " & vbCrLf & vbCrLf
Msg = Msg & "The UKDC Recruitment Team"

' 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 r
End Sub
--------------------


--
periro16
------------------------------------------------------------------------
periro16's Profile:

http://www.excelforum.com/member.php...o&userid=26345
View this thread: http://www.excelforum.com/showthread...hreadid=396763





All times are GMT +1. The time now is 03:05 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com