Automating Manual Date Changes recorded on another sheet.

hakantoz

New Member
Joined
Feb 28, 2014
Messages
28
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
[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Project[/TD]
[TD="width: 64"]Date1[/TD]
[TD="width: 64"]Date 2[/TD]
[TD="width: 64"]Date 3[/TD]
[/TR]
[TR]
[TD]Project A[/TD]
[TD="class: xl66, align: right"]1/1/2018[/TD]
[TD="class: xl66, align: right"]1/1/2018[/TD]
[TD="class: xl66, align: right"]3/3/2018[/TD]
[/TR]
[TR]
[TD]Project B[/TD]
[TD="class: xl66, align: right"]2/2/2018[/TD]
[TD="class: xl66, align: right"]2/2/2018[/TD]
[TD="class: xl66, align: right"]2/2/2018[/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2
A E F H
[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Project[/TD]
[TD="width: 64"]Date1[/TD]
[TD="width: 64"]Date 2[/TD]
[TD="width: 64"]Date 3[/TD]
[/TR]
[TR]
[TD]Project A[/TD]
[TD="class: xl66, width: 64"]1/1/2018
5/5/2017[/TD]
[TD="class: xl66, width: 64"]1/1/2018
6/6/2017[/TD]
[TD="class: xl66, width: 64"]3/3/2018
1/1/2018
7/7/2017[/TD]
[/TR]
[TR]
[TD]Project B[/TD]
[TD="class: xl66, width: 64"]2/2/2018
3/3/2017[/TD]
[TD="class: xl66, width: 64"]2/2/2018
4/4/2017[/TD]
[TD="class: xl66, width: 64"]2/2/2018
5/5/2017[/TD]
[/TR]
</tbody>[/TABLE]


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

Thank you so much for all help!
 
Try:
Code:
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
 
Upvote 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
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.
 
Upvote 0
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...
 
Upvote 0
See if this works for you:
Code:
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
 
Upvote 0
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!
 
Upvote 0
You are very welcome. :) I'm glad it all worked out.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top