Start Counting when cell changes

[Hoopsah]

Hi

I have a spreadsheet that I am a bit stuck with.

I have a dropdown option of either Yes or No in column A

In column B, I am looking to get a count in days from when the cell changed to Yes.

Any ideas?

All help will be appreciated

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A2" '<<<< change to suit
Dim SavedDate As Double
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value2 = "Yes" Then
SavedDate = GetSavedDate
If SavedDate = 0 Then
.Offset(0, 1).Formula = "=TODAY()-""" & Format(Date, "yyyy-mm-dd") & """"
.Offset(0, 1).NumberFormat = "0"
ThisWorkbook.Names.Add Name:="_savedDate", RefersTo:="=" & Date
End If
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Private Function GetSavedDate() As Date
On Error Resume Next
GetSavedDate = Application.Evaluate(ThisWorkbook.Names("_savedDate").RefersTo)
End Function


This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

[Hoopsah]

Hi Bob

thanks again for your help.

Just 1 thing, how would I make this for every cell in column A?

[Bob Phillips]

This should do it



Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A:A" '<<<< change to suit
Dim SavedDate As Double
Dim CellName As String
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value2 = "Yes" Then
CellName = "_savedDate" & .addres(False, False)
SavedDate = GetSavedDate(CellName)
If SavedDate = 0 Then
.Offset(0, 1).Formula = "=TODAY()-""" & Format(Date, "yyyy-mm-dd") & """"
.Offset(0, 1).NumberFormat = "0"
ThisWorkbook.Names.Add Name:=CellName, RefersTo:="=" & Date
End If
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Private Function GetSavedDate(CellName As String) As Date
On Error Resume Next
GetSavedDate = Application.Evaluate(ThisWorkbook.Names(CellName).RefersTo)
End Function

[Hoopsah]

Hi Bob

sorry about this.

When I ran with the first code, when I put Yes in cell A2, cell B2 populated with a formula and result showed 0.

The new code doesn't return anything when I type in Yes???

[Bob Phillips]

Yet again, that should teach me to test these things, a simple typo :(



Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A:A" '<<<< change to suit
Dim SavedDate As Double
Dim CellName As String
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value2 = "Yes" Then
CellName = "_savedDate" & .Address(False, False)
SavedDate = GetSavedDate(CellName)
If SavedDate = 0 Then
.Offset(0, 1).Formula = "=TODAY()-""" & Format(Date, "yyyy-mm-dd") & """"
.Offset(0, 1).NumberFormat = "0"
ThisWorkbook.Names.Add Name:=CellName, RefersTo:="=" & Date
End If
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Private Function GetSavedDate(CellName As String) As Date
On Error Resume Next
GetSavedDate = Application.Evaluate(ThisWorkbook.Names(CellName).RefersTo)
End Function

[Hoopsah]

Hi Bob

once again, works perfectly, thanks again for your help,

and please accept my apologies, I looked through the code this morning and saw "Address" spelt wrong. I should have noticed that sooner and not had to ask you again.

But, thanks again

Gerry

[Hoopsah]

Hi

sorry about this, the above works perfectly as asked for, I am now looking to try and tweak it though.

Still want it to do the same thing but now when a value is input into column C, is there a way I can then stop the counting and paste the value into the column B?

[Bob Phillips]

ANy value?



Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A:A" '<<<< change to suit
Const WS_RANGE2 As String = "C:C" '<<<< change to suit
Dim SavedDate As Double
Dim CellName As String
On Error GoTo ws_exit
Application.EnableEvents = False
With Target
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
If .Value2 = "Yes" Then
CellName = "_savedDate" & .Address(False, False)
SavedDate = GetSavedDate(CellName)
If SavedDate = 0 Then
.Offset(0, 1).Formula = "=TODAY()-""" & Format(Date, "yyyy-mm-dd") & """"
.Offset(0, 1).NumberFormat = "0"
ThisWorkbook.Names.Add Name:=CellName, RefersTo:="=" & Date
End If
End If
ElseIf Not Intersect(Target, Me.Range(WS_RANGE2)) Is Nothing Then
If .Offset(0, -2).Value2 = "Yes" Then
.Offset(0, -1).Value2 = .Offset(0, -1).Value2
End If
End If
End With
ws_exit:
Application.EnableEvents = True
End Sub

Private Function GetSavedDate(CellName As String) As Date
On Error Resume Next
GetSavedDate = Application.Evaluate(ThisWorkbook.Names(CellName).RefersTo)
End Function

[Hoopsah]

That is amazing Bob, it works perfectly.

Thanks again for your help

Cheers

Gerry