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
Bob Phillips
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?
Bob Phillips
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???
Bob Phillips
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?
Bob Phillips
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.