Need Help regarding VB Script in Excel

MAMDO

New Member
Joined
Mar 4, 2022
Messages
6
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hello,

Can anyone help me out ??

Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long
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 xRgSel = Intersect(Target, Range("R10:R20"))
ActiveWorkbook.Save
j = 10
For Each Cell in xRgSel
If xRgSel Is Nothing Then Exit Sub
If xRgSel = "A" or xRgSel = "B" or xRgSel = "C" Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.To = Cells(j, "S").Value
.Cc = Cells(j, "X").Value
.Subject = Cells(j, "Y").Value
.Body = Cells(j, "Z").Value
'.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
j = j + 1
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


What I'm stuck is that the output of S,X,Y & Z freeze into row 10 only. Whenever the value of R11 is given, the output of S,X,Y & Z remain same as row 10. Can anyone help me out solve this ??? Any modification with this script ???

N:B - S,X,Y & Z value already exists in the cell.
 

Attachments

  • excel.png
    excel.png
    19.7 KB · Views: 10

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Hi, the code you posted doesn't even compile.

ActiveWorkbook.Save

You might want to consider where exactly you want that line to execute - i.e. after every cell change seems excessive? Or should it be if a cell in the range "R10:R20" has changed, or should it be more specifically when one of those cells has changed and it's value has been changed to an "A","B" or "C" - for now, I've simply left it out.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range, xCell As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String

Set xRgSel = Intersect(Target, Range("R10:R20"))

If Not xRgSel Is Nothing Then
    Application.EnableEvents = False
    For Each xCell In xRgSel
        If xCell.Value = "A" Or xCell.Value = "B" Or xCell.Value = "C" Then
            Set xOutApp = CreateObject("Outlook.Application")
            Set xMailItem = xOutApp.CreateItem(0)
            With xMailItem
                .To = Cells(xCell.Row, "S").Value
                .Cc = Cells(xCell.Row, "X").Value
                .Subject = Cells(xCell.Row, "Y").Value
                .Body = Cells(xCell.Row, "Z").Value
                '.Attachments.Add (ThisWorkbook.FullName)
                .Display
            End With
        End If
    Next xCell
    Application.EnableEvents = True
End If
End Sub
 
Upvote 0
Hi, the code you posted doesn't even compile.



You might want to consider where exactly you want that line to execute - i.e. after every cell change seems excessive? Or should it be if a cell in the range "R10:R20" has changed, or should it be more specifically when one of those cells has changed and it's value has been changed to an "A","B" or "C" - for now, I've simply left it out.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range, xCell As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String

Set xRgSel = Intersect(Target, Range("R10:R20"))

If Not xRgSel Is Nothing Then
    Application.EnableEvents = False
    For Each xCell In xRgSel
        If xCell.Value = "A" Or xCell.Value = "B" Or xCell.Value = "C" Then
            Set xOutApp = CreateObject("Outlook.Application")
            Set xMailItem = xOutApp.CreateItem(0)
            With xMailItem
                .To = Cells(xCell.Row, "S").Value
                .Cc = Cells(xCell.Row, "X").Value
                .Subject = Cells(xCell.Row, "Y").Value
                .Body = Cells(xCell.Row, "Z").Value
                '.Attachments.Add (ThisWorkbook.FullName)
                .Display
            End With
        End If
    Next xCell
    Application.EnableEvents = True
End If
End Sub
If the user has given any value in a cell within the Range R10:R20 only then the other cell S,X,Y,Z (10:20) will take the value respectively and display it in the outlook application. But the script only hold the value of S,X,Y,Z (10) only for the Range R10:R20.
I want the output be like this:
From taking the value from the user in R10 Cell ; value of (S10, X10, Y10, Z10) will be displayed in the mail
R11 Cell; value of (S11, X11, Y11, Z11) will be displayed in the mail
Similarly the rest of the cell range will follow the same.
 
Upvote 0
Hi, did you try the code I posted?
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

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