Record and retain the date when cell value was FIRST changed!

Phil Payne · Nov 3, 2014

Hello all

I need your expert assistance again please.

I have status columns with validated codes (ascending from 1 to 11) on Sheet1 that when selected by the user inputs the date of change of status into an adjacent cell. Over time the status changes from 1 through to 11 and on each change of status the date in the adjacent cell changes accordingly.

All that is OK but now I need to record when a particular status is reached that, when subsequently changed, will not change the status date. (I need to retain for the record when each status 9 was achieved.)

Is there a way to record and retain the date when status value was FIRST changed to Status 9?

I presently display all the status dates found on Sheet1 (up to 6026) on Sheet2. I am hoping to modify the Sheet2 formula or employ VBA to get what I need.

I hope someone can provide a solution.

Thanks very much!

Phil Payne · Nov 4, 2014

jim may said:
we only need to locate it (the cell on Sheet2) by perhaps using match() or some other lookup method.

What sort of table setup do you have on sheet2, that I might offer a revision to the line "Target.Offset(, 2) = Date ?

Regards,

Jim

There are identical lists of sites in alphabetical order in both sheets, sheet1 is in Column F and Sheet 2 is in column B. Sheet2 checks to see if its corresponding site in Sheet1 is at Status 9 and if so returns the date held in Sheet1.

The Sheet2 in-cell formula for this is: =IF(($B4='Sheet1'!$F15)*('Sheet1'!V15='Sheet2'!$A$1),'Sheet1'!X15,0)

Sheet1 column V holds the site status. Sheet2 cell A1 holds the subject number '9'. Sheet1 column X holds the date the status was last changed.

Further information - there are many themes to each site all of which have their own status column. If I can get just one to work then I should get the others.

Hope this helps. Thanks very much for your efforts.

Phil

Redwolfx · Nov 4, 2014

I think this solves what you are looking for. I'm not sure if I followed you correctly.

If you have a seperate cell dedicated to the date of Status 9 achieved,

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

IF Range("Date Cell").VALUE = "" Then
     IF Range("Status Cell").Value = "Status 9" Then
          Range("Date Cell").Value = Date
     End If
End IF

End Sub

jim may · Nov 4, 2014

OK Phil -- I've got all the time in the world to work on this, but I'm sure you don't. So, for your sake this is my final offer, hoping it is of value to you. It is clearly a sample set up as I do not have your specific workbook (better understanding your layout).

Here is my modified Sheet1 - Column D is where an updated Stat code is assigned. As you change any cell in Column D the Macro Fires (Code sheet behind Sheet1). Only when in Column D you enter a 9 does Sheet2 get updated. I have offered instructive comments within the code to explain what is going on with each code line. If you can adjust the 2 sheet windows and the VBE code window so that all are visible at the same time + Enter a Breakpoint @ line 2 of the macro - you can see/view step-by-step what's going on as you begin the macro by entering a value in Column D of Sheet1.

Excel 2012

B

C

D

E

1

*** LAST ***

2

Job Name

Status

Stat Num Code

Status Date

3

Job 1

Mid-Point

3

9/15/2014

4

Job 2

Final

4

8/31/2014

5

Job 3

Just Started

5

7/31/2014

6

Job 4

Open

6

10/5/2014

Sheet1

Excel 2012

C

D

1

Job Name

Date Stat Code Chged to 9

2

Job 1

3

Job 2

4

Job 3

5

Job 4

Sheet2

This code (below) goes into the Sheet1 Code Window (Not a standard module).

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("D:D")) Is Nothing Then Exit Sub   ' code only fires if Col D is changed
Application.EnableEvents = False
    If Target.Value <> "" Then    'allows for you to press delete key in Col D to clear content of cell
    j = Target.Offset(, -2).Value  'assigns the currently changed job name to the variable "j"
    Target.Offset(, 1) = Date     'assigns todays date to Column E
    If Target.Value = 9 Then      'If your current record is changed to "9"
        With Sheet2                     ' then goto sheet2 and use LR to determine the Last non-blank row in column C
        LR = .Range("C" & .Rows.Count).End(xlUp).Row
        r = Application.WorksheetFunction.Match(j, .Range("C2:C" & LR), 0)    ' assign to the variable  "r" the Row # of  "j" in sheet2
        .Cells(r + 1, 4).Value = Date         ' then here we assign todays date to the Cell (r + 1 (because there is a header row), "4" < < this is Column D
        End With
        MsgBox "You have acheived Status 9"
    End If
    End If
Application.EnableEvents = True
End Sub

I hope this is of value for you, otherwise hang in there --there are so many qualified code-writers out there how can help. Jim

Phil Payne · Nov 5, 2014

Thanks very much for spending the time and effort to help me Jim.

I'll be working through your suggestions later today. I'm sure it will be of value as I'll learn from it at least.

I'll let you know how I get on.

Thanks again.

jim may said:
OK Phil -- I've got all the time in the world to work on this, but I'm sure you don't. So, for your sake this is my final offer, hoping it is of value to you. It is clearly a sample set up as I do not have your specific workbook (better understanding your layout).

Here is my modified Sheet1 - Column D is where an updated Stat code is assigned. As you change any cell in Column D the Macro Fires (Code sheet behind Sheet1). Only when in Column D you enter a 9 does Sheet2 get updated. I have offered instructive comments within the code to explain what is going on with each code line. If you can adjust the 2 sheet windows and the VBE code window so that all are visible at the same time + Enter a Breakpoint @ line 2 of the macro - you can see/view step-by-step what's going on as you begin the macro by entering a value in Column D of Sheet1.

Excel 2012

B C D E
Job Name Status
Job 1 Mid-Point
Job 2 Final
Job 3 Just Started
Job 4 Open

<tbody>
[TD="align: center"]1[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: center"]*** LAST ***[/TD]
[TD="align: center"][/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]Stat
Num
Code[/TD]
[TD="align: center"]Status
Date[/TD]

[TD="align: center"]3[/TD]

[TD="bgcolor: #FFFF00, align: center"]3[/TD]
[TD="align: right"]9/15/2014[/TD]

[TD="align: center"]4[/TD]

[TD="bgcolor: #FFFF00, align: center"]4[/TD]
[TD="align: right"]8/31/2014[/TD]

[TD="align: center"]5[/TD]

[TD="bgcolor: #FFFF00, align: center"]5[/TD]
[TD="align: right"]7/31/2014[/TD]

[TD="align: center"]6[/TD]

[TD="bgcolor: #FFFF00, align: center"]6[/TD]
[TD="align: right"]10/5/2014[/TD]

</tbody>
Sheet1

Excel 2012

C D
Job Name
Job 1
Job 2
Job 3
Job 4

<tbody>
[TD="align: center"]1[/TD]

[TD="bgcolor: #FFFF00, align: center"]Date Stat
Code Chged
to 9[/TD]

[TD="align: center"]2[/TD]

[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: right"][/TD]

[TD="align: center"]4[/TD]

[TD="align: right"][/TD]

[TD="align: center"]5[/TD]

[TD="align: right"][/TD]

</tbody>
Sheet2

This code (below) goes into the Sheet1 Code Window (Not a standard module).

Code:

Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Columns("D:D")) Is Nothing Then Exit Sub ' code only fires if Col D is changed Application.EnableEvents = False If Target.Value <> "" Then 'allows for you to press delete key in Col D to clear content of cell j = Target.Offset(, -2).Value 'assigns the currently changed job name to the variable "j" Target.Offset(, 1) = Date 'assigns todays date to Column E If Target.Value = 9 Then 'If your current record is changed to "9" With Sheet2 ' then goto sheet2 and use LR to determine the Last non-blank row in column C LR = .Range("C" & .Rows.Count).End(xlUp).Row r = Application.WorksheetFunction.Match(j, .Range("C2:C" & LR), 0) ' assign to the variable "r" the Row # of "j" in sheet2 .Cells(r + 1, 4).Value = Date ' then here we assign todays date to the Cell (r + 1 (because there is a header row), "4" < < this is Column D End With MsgBox "You have acheived Status 9" End If End If Application.EnableEvents = True End Sub

I hope this is of value for you, otherwise hang in there --there are so many qualified code-writers out there how can help. Jim

Phil Payne · Nov 8, 2014

Hello Jim,

I promised to let you know how I got on.

Your code works very well but the complication that we didn't fully discuss that I hoped to resolve myself, is well beyond my abilities. I'm hoping you can provide further guidance.

My Sheet1 contains 51 status columns each of which have adjacent cost and date columns. (Status/Cost/Date)
My Sheet2 is intended to have an identical column and row structure as my Sheet1

A previously needed to identify changes of status, colour code the related cost field and populating the related date field and I managed to do it by using vba starting with:-

If (Target.Column >= 21) And (Target.Column <= Range("FO1").Column) And (Target.Column Mod 3 = 0) And (Target.Row >= 15) And (Target.Row <= LastRow) Then

I was hoping to combine your solution for a single status column with the above but I'm truly a novice (dunce) at VBA. I hope you will perhaps provide some suggestions or solution?

Many thanks for your time and effort.

Phil

jim may · Nov 8, 2014

Hey Phil,

I'll give it a shot... from the below If statement code (Which is obviously in Sheet1's event code module) I can see that you begin your individual status cell testing in Cell U15 and it runs (status, colour, date) consequtive ONLY through FN, not FO..(?) Please post your existing code that runs when the THEN statement is TRUE, and if false (if such applies). We will need to add to this code to update your sheet2 cell(s).

Code:

'code behind Sheet1:
If (Target.Column >= 21) And (Target.Column <= Range("FO1").Column) And (Target.Column Mod 3 = 0) And (Target.Row >= 15) And (Target.Row <= LastRow) Then
??????????????

End if

Jim

Phil Payne · Nov 8, 2014

Thanks very much Jim.
I've copied the whole code below.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'''''### ADDING OR DELETING COLUMNS - MESSAGES
Application.EnableEvents = False
'### 1 ###
'ADDING OR DELETING COLUMNS
'A Named Range (ColTest1) has been set up in a cell in Row 1 to right side of active area - do not delete or rename
''''If ActiveWorkbook.Name = ("01 EDU Refurbishment Pricing Sheet.xls") Then
                If Sheets("Data Sheet").Range("ColTest1").Column = Sheets("Data Sheet").Range("ColTest1").Value Then
                'MsgBox only for demo. Normally no code required if no Insert/Delete
                'MsgBox "No column inserted or deleted"
                GoTo TestRows
                End If
                If Sheets("Data Sheet").Range("ColTest1").Column > Sheets("Data Sheet").Range("ColTest1").Value Then
                'Insert you code here in lieu of the MsgBox
                MsgBox Range("ColTest1").Column - Range("ColTest1").Value & " Column/s inserted." & vbNewLine & vbNewLine & "Ensure all summing formulae include the new column/s within their ranges!"
                GoTo TestRows
                End If
                If Sheets("Data Sheet").Range("ColTest1").Column < Sheets("Data Sheet").Range("ColTest1").Value Then
                'Insert you code here in lieu of the MsgBox
                MsgBox Range("ColTest1").Value - Range("ColTest1").Column & "                 COLUMN/S DELETED!" & vbNewLine & vbNewLine & "COLUMNS CAN BE HIDDEN BUT NOT DELETED!" & vbNewLine & vbNewLine & "         RESTORE DELETED COLUMN/S NOW!" & vbNewLine & vbNewLine & "    You may have to exit file without saving!"
                GoTo TestRows
                End If
        '### 1 ###
        '### 2 ###
        'ADDING OR DELETING ROWS
        'A Named Range (RowTest1) has been set up in a cell in Column A imediately below active area - do not delete or rename
TestRows:
                If Sheets("Data Sheet").Range("RowTest1").Row = Sheets("Data Sheet").Range("RowTest1").Value Then
                'MsgBox only for demo. Normally no code required if no Insert/Delete
                'MsgBox "No Row inserted or deleted"
                GoTo ReEnableEvents
                End If
                If Sheets("Data Sheet").Range("RowTest1").Row > Sheets("Data Sheet").Range("RowTest1").Value Then
                'Insert you code here in lieu of the MsgBox
                MsgBox Range("RowTest1").Row - Range("RowTest1").Value & "                          ROW/S INSERTED!" & vbNewLine & vbNewLine & "ENSURE PROJECT IS REGISTERED BEFORE PROCEEDING!" & vbNewLine & vbNewLine & "THEN REPEAT PROCESS WITH TABLES IN:" & vbNewLine & "PRF, CLO Print, Status Checker, Status 1 Checker and Defects Liability Starts worksheets"
                GoTo ReEnableEvents
                End If
                If Sheets("Data Sheet").Range("RowTest1").Row < Sheets("Data Sheet").Range("RowTest1").Value Then
                'Insert you code here in lieu of the MsgBox
                MsgBox Range("RowTest1").Value - Range("RowTest1").Row & "             ROW/S DELETED!" & vbNewLine & vbNewLine & "    ROWS MUST NEVER BE DELETED!" & vbNewLine & vbNewLine & "    RESTORE DELETED ROW/S NOW!" & vbNewLine & vbNewLine & "You may have to exit file without saving!"
                GoTo ReEnableEvents
                End If
        '### 2 ###
''''Else: MsgBox Range("This is not the EDU Pricing Sheet!")
                GoTo ReEnableEvents
        '### 3 ###
ReEnableEvents:
                Sheets("Data Sheet").Range("ColTest1") = Sheets("Data Sheet").Range("ColTest1").Column
                Sheets("Data Sheet").Range("RowTest1") = Sheets("Data Sheet").Range("RowTest1").Row
                Application.EnableEvents = True
        '### 3 ###
''''End If
' This code checks for a change of Status in the Status column and
'   on change fills the adjacent Cost cell with appropriate colour then
'   enters current date into the adjacent Date cell.
' The range covered extends from column ‘R’ (first Status column), to column ‘EZ’ (last Status column).
' If adding columns adjust ranges accordingly!
    If Target.Count > 1 Then Exit Sub
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Dim rCell As Range
    Dim rCodes As Range
    Dim rRow As Range
    Dim vMatch
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
    Set rCodes = Range("E2:E12")
    If (Target.Column >= 21) And (Target.Column <= Range("FO1").Column) And (Target.Column Mod 3 = 0) And (Target.Row >= 15) And (Target.Row <= LastRow) Then
        If Len(Target.Value) > 0 Then
            On Error Resume Next
            vMatch = Application.Match(Target.Value, rCodes, 0)
            If IsError(vMatch) Then
                MsgBox "Invalid code selected"
                With Target.Cells
                     .Offset(0, -1).Font.ColorIndex = xlAutomatic
                     .Offset(0, -1).Interior.Color = xlNone
                End With
            Else
                With Target
                    .Offset(, 1).Interior.Color = rCodes.Cells(vMatch).Interior.Color
                    .Offset(, 1).Font.Color = rCodes.Cells(vMatch).Font.Color
                    .Offset(, 2).Interior.Color = rCodes.Cells(vMatch).Interior.Color
                    .Offset(, 2).Font.Color = rCodes.Cells(vMatch).Font.Color
                    .Offset(0, 2).Value = Date
                End With
            End If
        End If
    End If
'CODE TO ENTER DATE ROW CHANGED IN CELL IN SAME ROW AT COLUMN [FG]
' The range covered extends from column ‘R’ (first Status column), to column ‘FA’ (last COST column).
' If adding columns adjust ranges accordingly!
   If Not Intersect(Target, Range("R:FQ")) Is Nothing Then
      For Each rCell In Intersect(Target, Range("R:FQ")).Cells
        If (Target.Row >= 15) And (Target.Row <= LastRow) Then Cells(Target.Row, "FV") = Now()
        If (Target.Row >= 15) And (Target.Row <= LastRow) Then Cells(Target.Row, "FW") = Environ("Username")
        ' THESE DESTINATION CELLS IN WORKSHEET MUST HAVE SECURITY PREOTECTION OFF"
      Next rCell
   End If
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
'Application.EnableEvents = True
End Sub

jim may said:
Hey Phil,

I'll give it a shot... from the below If statement code (Which is obviously in Sheet1's event code module) I can see that you begin your individual status cell testing in Cell U15 and it runs (status, colour, date) consequtive ONLY through FN, not FO..(?) Please post your existing code that runs when the THEN statement is TRUE, and if false (if such applies). We will need to add to this code to update your sheet2 cell(s).

Code:

'code behind Sheet1: If (Target.Column >= 21) And (Target.Column <= Range("FO1").Column) And (Target.Column Mod 3 = 0) And (Target.Row >= 15) And (Target.Row <= LastRow) Then ?????????????? End if

Jim

Phil Payne · Nov 8, 2014

Hello Jim,
Please note my remarks are out of sync with the code. They are there as reminders for when I next come back to update it.
Regards,
Phil

jim may · Nov 8, 2014

I have to run out and do errands for the afternoon, but I'll get back to this when I return... Jim

Phil Payne · Nov 9, 2014

Thanks Jim.

Record and retain the date when cell value was FIRST changed!

Phil Payne

Board Regular

Phil Payne

Board Regular

Excel Facts

Redwolfx

Well-known Member

jim may

Well-known Member

Phil Payne

Board Regular

Phil Payne

Board Regular

jim may

Well-known Member

Phil Payne

Board Regular

Phil Payne

Board Regular

jim may

Well-known Member

Phil Payne

Board Regular

Similar threads

Forum statistics

Share this page

Record and retain the date when cell value was FIRST changed!

Board Regular

Board Regular

Excel Facts

Well-known Member

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock