If Cells Changes then Enter Date

[ianb]

Hi,

I have Cells A1 to A8 as an example. I send emails to people and the cell changes from Email Await to Email Sent. How can I place the Date the email was sent into B1 to A8 each time I open the spreadsheet. I have auto email sent and my VBA program changes the Cell range in A.

I already have a trigger for the date for it to be sent yet this could be on a saturday whilst I only run the spreadsheet on a monday-friday so I need to have a new date in B?

Does any one have a simple solution in VBA e.g If A? changes to Email Sent then enter today's date else if already Email Sent or Email Await then do nothing.

Email Sent
Email Await
Email Sent
Email Await
Email Sent
Email Sent
Email Await
Email Sent

Thanks.

 

[ianb]

Here is my program @ present. The Email part of the Program is called when required Sub Mail_with_outlook2

Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double
NotSentMsg = "Not Sent"
SentMsg = "Sent"
' SentMsg = "Sent" & "-" & Date
'Above the MyLimit value it will run the macro
MyLimit = 0
'Set the range with Formulas that you want to check
Set FormulaRange = Me.Range("i3:i134")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
If IsNumeric(.Value) = False Then
MyMsg = "Not numeric"
Else
If .Value > MyLimit Then
MyMsg = SentMsg
If .Offset(0, 1).Value = NotSentMsg Then
Call Mail_with_outlook2
End If
Else
MyMsg = NotSentMsg
End If
End If
Application.EnableEvents = False
.Offset(0, 1).Value = MyMsg
Application.EnableEvents = True
End With
Next FormulaCell
ExitMacro:
Exit Sub
EndMacro:
Application.EnableEvents = True
MsgBox "Some Error occurred." _
& vbLf & Err.Number _
& vbLf & Err.Description
End Sub

 

[Luke M]

I think this is what you want. Not sure on columns, as your originally post said col A and B, but macro calls out col I.

Private Sub Worksheet_Calculate()
 Dim FormulaRange As Range
 Dim NotSentMsg As String
 Dim MyMsg As String
 Dim SentMsg As String
 Dim MyLimit As Double
 NotSentMsg = "Not Sent"
 SentMsg = "Sent"
 ' SentMsg = "Sent" & "-" & Date
 'Above the MyLimit value it will run the macro
 MyLimit = 0
 'Set the range with Formulas that you want to check
 Set FormulaRange = Me.Range("i3:i134")
 On Error GoTo EndMacro:
 For Each FormulaCell In FormulaRange.Cells
  With FormulaCell
  If IsNumeric(.Value) = False Then
  MyMsg = "Not numeric"
  Else
  If .Value > MyLimit Then
  MyMsg = SentMsg
  If .Offset(0, 1).Value = NotSentMsg Then
  Call Mail_with_outlook2
  
  'Edit by Luke M
  'This is where we have sent an email, so add new line
  .Offset(0, 1).Value = Date
  
  End If
  Else
  MyMsg = NotSentMsg
  End If
  End If
  Application.EnableEvents = False
  .Offset(0, 1).Value = MyMsg
  Application.EnableEvents = True
  End With
 Next FormulaCell
 
ExitMacro:
 Exit Sub
EndMacro:
 Application.EnableEvents = True
 MsgBox "Some Error occurred." _
 & vbLf & Err.Number _
 & vbLf & Err.Description
 End Sub

 

[ianb]

Hi Luke, Thanks. It is close. Can you see if you can get this working. I have tried.

Please do not put Off set 0,2 in as it loops on the display email !!! lol

 

[ianb]

Hi Luke, Tried it again as a module with an update button. using offset 0,2 and it has worked. I do not understand. Will need to do more testing. you are welcome to advise if required Many Thanks. Ian.

 

[ushaanu]

hi ,

i use this file for my work and it`s working fine but i am facing one issue that mail not send automatically . mail draft not send i have to click send button then it`s send.