Macro That Sends Email to Address in Column B When Data is Added to Column S

Hi,

I have a spreadsheet generated by Microsoft Forms that updates information in new rows everytime the form is submitted.

Column C contains the submitter's email address. When the request has been completed, I enter the "Date Completed" in Column S. When I enter this information, I want it to send an email to the email address located in Column B. The Subject needs to be the information in Column H and the body needs to include information from Column T.

I also want the loop to go from i = 2 to the last used cell but do not know how to reference this.

This is what I have so far but no matter where I fill out the information in Column S, it only takes the information from row 2. If the date is entered in S15, for example, then it needs to use the email address from C15 and the information from H15 and T15. Is there a way to do this??

This is what I have so far (I used i = 2 to 1000 arbitrarily because I could not figure this part out). It works this way, but then it takes way too long to finish the loop and sometimes freezes Excel. Is there a way to shorten this range for something like i = 2 to (Last Used Row).


Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("S:S")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save

For i = 2 To 1000
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Purification " & Cells(i, 8).Value & " is Complete." & vbNewLine & vbNewLine & "The following method was used: " & Cells(i, 20).Value
With xMailItem
.To = Cells(i, 3).Value
.Subject = "Purification " & Cells(i, 8).Value & " is Complete"
.Body = xMailBody
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Next

End Sub


Thanks for your insight!

Instead of 1000, use this in the line to find the last cell:

Please Login or Register  to view this content.

Thanks! This sped up the macro quite a bit! Now, just to get it to do what I want it to!

Please Login or Register  to view this content.

Originally Posted by Logit

Please Login or Register  to view this content.

I tried this and it generated emails for every single row in the spreadsheet when the value was changed in column S. I need it so that an email is only generated for the row that changed. For example, if S15 is changed, the only email generated should be from the data in row 15.

Is this possible?

.
Will an email be sent only once when the Col S value changes ?

Or are you expecting anytime the Col S value changes, even if it had changed previously, an email will be sent ?

The email will only be sent once. Basically the cell in column S is empty and when this item is completed, I enter the "Date Complete" in Column S, and then it should send the email.

I found a slightly different way and it worked!

When I enter the date and press enter, the Active Cell is in the row below the target row so I just used Cells(ActiveCell.Row - 1, "Column Number") to fetch the data.

Thanks for all of your input!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("S:S")
Set xRgSel = Intersect(Target, xRg)

ActiveWorkbook.Save


If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Purification " & Cells(ActiveCell.Row - 1, 8).Value & " is Complete." & vbNewLine & vbNewLine & "The following method was used: " & Cells(ActiveCell.Row - 1, 20).Value

With xMailItem
.To = Cells(ActiveCell.Row - 1, 3).Value
.Subject = "Purification " & Cells(ActiveCell.Row - 1, 8).Value & " is Complete"
.Body = xMailBody
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

.
You need to place your posted code inside the # symbol, selected from the REPLY menu bar. Please edit your last post.

I edited your last posted macro, removing the -1 from all lines where present and the code functions as desired here.

Please Login or Register  to view this content.