Automating Manual Date Changes recorded on another sheet.

[hakantoz]

I have two sheets on the first sheet, Column A have the project name, I have Columns K, L, U where I have dates that change on a weekly basis. On Sheet two I have same thing starting with A27, I have the same project names, however on F27, G27 and H27 where I manually enter the historical changes of dates manually stacked.

What I am trying to do is on sheet two, if K, L, U dates change at any time on sheet one, record them on sheet two, for the right project(names to match ) and have those stacked where the newest value is on top in the cell and past ones are pushed to bottom.

i.e. where on sheet 1 on U column, once date 3 changed to 3/3/2018 for project A , it should add it on sheet 2, column H, for project A, for the Date 3.


Sheet1
A K L U

Project	Date1	Date 2	Date 3
Project A	1/1/2018	1/1/2018	3/3/2018
Project B	2/2/2018	2/2/2018	2/2/2018

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

Sheet 2
A E F H

Project	Date1	Date 2	Date 3
Project A	1/1/2018 5/5/2017	1/1/2018 6/6/2017	3/3/2018 1/1/2018 7/7/2017
Project B	2/2/2018 3/3/2017	2/2/2018 4/4/2017	2/2/2018 5/5/2017

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

Also wondering whether a way to utilize concatenate here without vba?

Thank you so much for all help!

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K:K")) Is Nothing Then Exit Sub
    Dim project As Range, rDate As Range
    Set project = Sheets("Sheet2").Range("A27:A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row).Find(Cells(Target.Row, 23).Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not project Is Nothing Then
        Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 11).Value, LookIn:=xlValues, lookat:=xlWhole)
        Sheets("Sheet2").Cells(project.Row, rDate.Column) = Target & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
        Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
        Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 12).Value, LookIn:=xlValues, lookat:=xlWhole)
        Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "L") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
        Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
        Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 18).Value, LookIn:=xlValues, lookat:=xlWhole)
        Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "R") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
        Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
        Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 21).Value, LookIn:=xlValues, lookat:=xlWhole)
        Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "U") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
        Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
    End If
End Sub

 

[mumps]

I posted the code before I saw your last post. If you change Date 2 in Sheet1, nothing should happen to Sheet2 because the macro will be triggered only if the change is made in Date 1 (column K). If you manually change a value in any of the other 3 columns, the formula currently in those columns will be overwritten by the new value and so the formula will be gone. Is that what you want to do? Please be very detailed in what you want to accomplish.

 

[hakantoz]

Strikethrough works great now thanks so much for that however, issue with manually changing values ( basically breaking the formula ) continues. So Basically on column L (date 2), lets say if date is achieved on a later date, I end up manually writing the date down ( basically removing the formula) then expect the date3 and date 4 to be updated based on their formulas.

Same thing will happen, if date 3 is achieved( manually changed with the right date and formula will be removed ) and expect date 4 to be changed.

So each date have dependency to the previous date and just want this dependency to be honored and recorded on sheet2 either if they are automatically calculated or manually entered and updated on sheet 2.


on your end you can see how it records by basically changing just date 2 and see how it is updated on sheet 2. It should just update date2, date 3 and date4 values and not touch date 1...

 

[mumps]

See if this works for you:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K:L,R:R,U:U")) Is Nothing Then Exit Sub
    Dim project As Range, rDate As Range
    Set project = Sheets("Sheet2").Range("A27:A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row).Find(Cells(Target.Row, 23).Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not project Is Nothing Then
        Select Case Target.Column
            Case Is = 11
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 11).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Target & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 12).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "L") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 18).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "R") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 21).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "U") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
            Case Is = 12
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 12).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "L") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 18).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "R") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 21).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "U") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
            Case Is = 18
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 18).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "R") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 21).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "U") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
            Case Is = 21
                Set rDate = Sheets("Sheet2").Rows(26).Find(Cells(1, 21).Value, LookIn:=xlValues, lookat:=xlWhole)
                Sheets("Sheet2").Cells(project.Row, rDate.Column) = Cells(Target.Row, "U") & Chr(10) & Sheets("Sheet2").Cells(project.Row, rDate.Column)
                Sheets("Sheet2").Cells(project.Row, rDate.Column).Characters(11, 9999).Font.Strikethrough = True
        End Select
    End If
End Sub

 

[hakantoz]

This works perfect! mumps I cannot thank you enough for your time, patience and energy to make this to work! Thank you, Thank you a million!

 

[mumps]

You are very welcome. I'm glad it all worked out.