PDA

View Full Version : Solved: Start Counting when cell changes



Hoopsah
07-27-2011, 02:34 AM
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

xld
07-27-2011, 02:57 AM
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
07-27-2011, 03:34 AM
Hi Bob

thanks again for your help.

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

xld
07-27-2011, 04:18 AM
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
07-27-2011, 04:33 AM
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???

xld
07-27-2011, 08:45 AM
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
07-28-2011, 01:05 AM
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
08-02-2011, 03:48 AM
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?

xld
08-02-2011, 04:09 AM
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
08-02-2011, 04:18 AM
That is amazing Bob, it works perfectly.

Thanks again for your help

Cheers

Gerry