SOLVED

Is it possible to record data in a cell whenever another specific data cell changes?

Copper Contributor

Hello, 

 

 I'm having trouble to find a way to copy in a cell the changes of another cell... let me explain myself.

 

In one column I have the dates of "Estimated time of Departures" of the vessels (ETD).

As today there have been a lot of changes of these dates due to the pandemic crisis I wan to record in another cell everytime a date changes. Example:

 

I will be using  (dd/mm/yyyy)

today is 01.03.2021 and the vessel is expected to depart on 08.03.2021

      A1                    B1

ETD             |      Rollings        |

08.03.2021  |      08.03.2021   |

 

then , today is 04.03.2021 and the departure of the vessel was rolled to March 12th . I will update the dates but I want B1 to record the date if A1 changes its value without deleting the last change... let me show you:

 

    A1                    B1

ETD             |      Rollings                            |

12.03.2021  |      08.03.2021 / 12.03.2021   |

 

now it's March 5th and again the vessel was rolled, now to March 15th, I want B1 to do this:

 

  A1                    B1

ETD             |      Rollings                                                  |

15.03.2021  |      08.03.2021 / 12.03.2021 /   15.03.2021  |

 

In conclusion, I want A2 to compare A1 with the last change it did to itself. If it is different to the last input the cell will append it at the end.

 is that possible? I don't want to add rows  or columns every time the cell changes.

 

I hope someone can help me with this.

 

Thanks!

 

 

 

4 Replies
best response confirmed by nahumjaime (Copper Contributor)
Solution

@nahumjaime 

The following will work in the desktop versions of Excel (for Windows and MacOS), not in the online version, nor in the versions for Android and iOS.

Let's say you want to apply this to cells A2:A100.

Right-click the sheet tab of the worksheet.

Select 'View Code' from the context menu.

Copy the following code into the worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim dtm As String
    If Not Intersect(Range("A2:A100"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        For Each rng In Intersect(Range("A2:A100"), Target)
            If IsDate(rng.Value) Then
                dtm = Format(rng.Value, "dd.mm.yyyy")
                If Not rng.Offset(0, 1).Value Like "*" & dtm Then
                    If rng.Offset(0, 1).Value = "" Then
                       rng.Offset(0, 1).Value = dtm
                    Else
                       rng.Offset(0, 1).Value = rng.Offset(0, 1).Value & " / " & dtm
                    End If
                End If
            End If
        Next rng
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Switch back to Excel.

Save the workbook as a macro-enabled workbook (.xlsm).

Make sure that you allow macros when you open the workbook.

Hello @Hans Vogelaar.!!

 

 I'm working on a large company where we have a lot of lines of shipments. We are using Excel Online for updating the ETDs and recording on a column the rolling of these ETDs. I've been watching some videos of how to program a sheet on Excel Online using JS but is it possible to run this same program on Excel Online?

@nahumjaime 

VBA does not work in the online version.

I cannot help you with a script that works on the web, sorry.

1 best response

Accepted Solutions
best response confirmed by nahumjaime (Copper Contributor)
Solution

@nahumjaime 

The following will work in the desktop versions of Excel (for Windows and MacOS), not in the online version, nor in the versions for Android and iOS.

Let's say you want to apply this to cells A2:A100.

Right-click the sheet tab of the worksheet.

Select 'View Code' from the context menu.

Copy the following code into the worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim dtm As String
    If Not Intersect(Range("A2:A100"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        For Each rng In Intersect(Range("A2:A100"), Target)
            If IsDate(rng.Value) Then
                dtm = Format(rng.Value, "dd.mm.yyyy")
                If Not rng.Offset(0, 1).Value Like "*" & dtm Then
                    If rng.Offset(0, 1).Value = "" Then
                       rng.Offset(0, 1).Value = dtm
                    Else
                       rng.Offset(0, 1).Value = rng.Offset(0, 1).Value & " / " & dtm
                    End If
                End If
            End If
        Next rng
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Switch back to Excel.

Save the workbook as a macro-enabled workbook (.xlsm).

Make sure that you allow macros when you open the workbook.

View solution in original post