Capture Dates

[cja65]

Hi,
I have a spreadsheet of projects that I am trying to record and save the dates each phase is completed. I want to use Private Sub Worksheet_Change(ByVal Target As Range) so it would update automatically but I can't figure out the code. The data is in a table with column S being the stage (1 through 8) and columns T through AA being the columns I want to store the dates each stage is completed. The table has projects added as needed so the code has to be able to self expand as the columns are added. If for example the stage of project 06 is changed from 2 to 3, then cell V7 will capture todays date - now(). If the same project stage is changed from stage 2 directly to stage 7 then the only cell that will capture the date is cell Z7, cells W7 to Y7 will remain empty. I appreciate any insight. Thanks.

 

[dreid1011]

See if this does what you want:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("S2:S30")) Is Nothing And Target > 0 And Target < 9 Then
    Target.Offset(0, Target.Value) = Date
End If
End Sub

Col S entries limited to 1-8.

 

[cja65]

dreid1011, thanks. This sets the appropriate column as I needed. Since this table changes in size, is there a way to set the range to be dynamic? currently the table has 77 projects (rows 2 through 78) I have a separate data input sheet that adds a row to this table with the new job when needed. I would like this code to automatically expand the range to include any added (or deleted) columns.

Thanks again!

 

[Joe4]

Just set it to some row you will never hit, i.e.
change

Range("S2:S30")

to something like:

Range("S2:S1000")

And if you might have more than 9 columns, just change this part:

Target < 9

to the maximum number of date columns you will have.

 

[dreid1011]

dreid1011, thanks. This sets the appropriate column as I needed. Since this table changes in size, is there a way to set the range to be dynamic? currently the table has 77 projects (rows 2 through 78) I have a separate data input sheet that adds a row to this table with the new job when needed. I would like this code to automatically expand the range to include any added (or deleted) columns.

Thanks again!

You can change the range as Joe mentioned, or if you really need it dynamic, try this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("S2:S" & Range("D" & Rows.Count).End(xlUp).Row)) Is Nothing And Target > 0 And Target < 9 Then
    Target.Offset(0, Target.Value) = Date
End If
End Sub

 

[cja65]

Thanks. I already set it to 2500.

It does have another problem. The stage is actually calculated using the formula

=VALUE(LEFT(E4,1))

The code doesn't work given that column S is a formula and not a hard number?

If I drag the formula up from cell S5 into S4 it will add the date to X4, but if I just change the Stage in column E4 it doesn't. Column E4 is a list of the 8 stages in a pull down data validation list.

 

[dreid1011]

Thanks. I already set it to 2500.

It does have another problem. The stage is actually calculated using the formula

=VALUE(LEFT(E4,1))

The code doesn't work given that column S is a formula and not a hard number?

If I drag the formula up from cell S5 into S4 it will add the date to X4, but if I just change the Stage in column E4 it doesn't. Column E4 is a list of the 8 stages in a pull down data validation list.

View attachment 116734

Okay, well that changes things and would be an important thing to note in the original request. Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E2:E" & Range("D" & Rows.Count).End(xlUp).Row)) Is Nothing And Target > 0 And Target < 9 Then
    Target.Offset(0, Target.Value + 14) = Date
End If
End Sub

 

[dreid1011]

And this update to prevent erroring if you select more than one cell anywhere on the sheet to delete anything:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then
    Exit Sub
Else
    If Not Intersect(Target, Range("E2:E" & Range("D" & Rows.Count).End(xlUp).Row)) Is Nothing And Target > 0 And Target < 9 Then
        Target.Offset(0, Target.Value + 14) = Date
    End If
End If
End Sub

 

[Joe4]

=VALUE(LEFT(E4,1))

The code doesn't work given that column S is a formula and not a hard number?

The issue is that formula returns a TEXT value, not a numeric one, as is evidenced by the little green triangle showing up in the upper right corner of every cell in column S.
You can easily update that formula to make it return a valid numeric value like this:

=LEFT(E4,1)+0

 

[cja65]

The code won't put in the date. Looks like what I can find on line is that the worksheet CHANGE sub doesn't work on cells where there is a formula or a data validation. That being said, neither referring to column E or adding the =left(e4,1)+0 will do the trick. I am still working on it but am a novice to say the least. Thanks for all of your help BTW