PDA

View Full Version : VBA code to delete contents of one cell based on change in another



kasabel
04-04-2018, 02:47 AM
Hello,

I have been working on a spreadsheet within which I have an auto email on Worksheet_Open which sends out a reminder email based on the date field falling within a certain number of days:

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String


With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With


Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row


For i = 2 To lRow
toDate = Replace(Cells(i, 3), ".", "/")
If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


toList = Cells(i, 4) 'gets the recipient from col D
eSubject = "PARIS ID: " & Cells(i, 2) & " Due on " & Cells(i, 3) & Cells(i, 6)
eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Please be reminded of the payment detailed in the subject line above and take the required action."

On Error Resume Next
With OutMail
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i


ActiveWorkbook.Save


With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)


Dim c As Excel.Range

'// It will error if no cells in Col J changed
On Error GoTo Catch

'// Stop any changes made here firing the Event again
Application.EnableEvents = True

'// For each changed cell in Col C
For Each c In Intersect(Range("C:C"), Target)

'// If it now contains something then
If c.Value <> vbNullString Then
'// Blank cell in Col E, same row
c.Offset(, 2).Value = vbNullString
End If
Next


Catch:


'// Make sure event handling is turned on again
'// Critical. Excel stops responding to everything
'// if not reset.
Application.EnableEvents = True

End Sub

This works a treat and puts a mail sent dialogue in the pertinent row where the email was sent in relation to the days falling within parameter I have set.

However, the date cell which prompts the email reminder to be sent changes based on formula contained in another sheet which is based on variables associated with =NOW(). So the formula within the date cell is ='Payment Detail 1718'!Q10.

What I want to be able to do is have code within the workbook which will clear the contents of the mail sent dialogue where this date cell value changes as this will then reset the send email macro and allow for perpetual sending of reminders emails based on new payment dates.

I have searched for and tried a wide variety of clear content code to no avail.

I can email the spreadsheet should anyone be able to help to give a clearer idea of what I am working on.

Also, any suggestions alternative to my approach are very welcome.

Many thanks.

K

kasabel
04-04-2018, 03:06 AM
*Update*

I have got the first part of the code to work which identifies changes in the range but at the moment still struggling with the clear contents aspect. The following is the start of the code really:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Call Macro1
End If
End Sub

With the Call Macro1 being where I can plant the clear contents code.

*Edit* I can only get it to work with a manual input though - it doesn't work when the cell is updated through the formula :(

*Edit2* I've got it to work:

Private Sub Worksheet_Calculate()
Static oldval
If Range("C2").Value <> oldval Then
oldval = Range("C2").Value
Worksheets("Sheet1").Range("$E$2").ClearContents
End If
End Sub

However, I have a final issue in that once it clears the contents it fires the email out again but does not replace the Reminder text on subsequent fires - so this will mean that it will keep sending out email on workbook_open arrrghh!

Anyone got any ideas?