Dazzybeeguy
Board Regular
- Joined
- Jan 6, 2022
- Messages
- 111
- Office Version
- 365
- 2010
- Platform
- Windows
I want to modify this VBA so that it looks at the cell being modified i.e E35 and instead of mentioning E35 in the generated email I want it to reference the date which would always be in cell 3 of that Row i.e E3
So if I change E35 it says Shift Change E35 In the 23/24 Roster '' One of your shifts was changed on 01/26/2023 at 07:50:09 by By Username.
I would like it to say A Shift Change has been made for the 4th June in the 23/24 Roster '' on the 01/26/2023 at 07:50:09 by By Username.
Thanks
Private Sub Worksheet_Change(ByVal Target As Range)
'Generate Email on Shift Change
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("d3:nd45")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Shift Change " & xRgSel.Address(False, False) & _
" In the 23/24 Roster '" & "' One of your shifts was changed on " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" by " & Environ$("username") & "Please check the Roster for fuller details "
With xMailItem
.To = "Email Address"
.Subject = "Shift Change Notification "
.Body = xMailBody
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
So if I change E35 it says Shift Change E35 In the 23/24 Roster '' One of your shifts was changed on 01/26/2023 at 07:50:09 by By Username.
I would like it to say A Shift Change has been made for the 4th June in the 23/24 Roster '' on the 01/26/2023 at 07:50:09 by By Username.
Thanks
Private Sub Worksheet_Change(ByVal Target As Range)
'Generate Email on Shift Change
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("d3:nd45")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Shift Change " & xRgSel.Address(False, False) & _
" In the 23/24 Roster '" & "' One of your shifts was changed on " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" by " & Environ$("username") & "Please check the Roster for fuller details "
With xMailItem
.To = "Email Address"
.Subject = "Shift Change Notification "
.Body = xMailBody
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub