CODEWITHSUNDEEP
vbaexcel
CWN
CWN

Reputation: 13

VBA Record date of row change in specific column

I'm trying to automatically update the "Updated" column of an excel spreadsheet when any cell of that specific row changes to today's date. I was able to do this by hard-coding where the "Updated" column header would be, however, it is now necessary to search for that column header as it may move.

The code I am trying to implement works but immediately gives me the error Automation error - The object invoked has disconnected from it's clients.

Any help would be appreciated. Here is the code I have currently:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:DX")) Is Nothing Then
        Dim f As Range

        Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole)
        ' f.Row = Range(Target).Row

        If Not f Is Nothing Then
           Range(Split(f.Address, "$")(1) & Target.Row).Value = Now
        Else
            MsgBox "'Updated' header not found!"
        End If
    End If
End Sub

Upvotes: 1

Views: 189

Answers (3)

Dirk Horsten
Dirk Horsten

Reputation: 3845

You got into an endless loop. Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:DX")) Is Nothing Then
        Dim f As Range

        Set f = ActiveSheet.Range("A1:DD1").Find("Updated", lookat:=xlWhole)
        ' f.Row = Range(Target).Row

        If f Is Nothing Then
            MsgBox "'Updated' header not found!"
        ElseIf Intersect(Target, f.EntireColumn) Is Nothing Then
            Intersect(Target.EntireRow, f.EntireColumn).Value = Now
'        Else
'            MsgBox "We entered this function again because the row above updated the Updated column", vbInformation, "False alarm"
        End If
    End If
End Sub

To understand what happens,

  • Uncomment the else and MsgBox
  • Put a breakpoint on the MsgBox
  • When you hit it, press [ctrl]-L

Upvotes: 1

user4039065
user4039065

Reputation:

It isn't clear on whether the Updated column header could be in row 1 or if it will always be in row 1, just not in the same location.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:DX")) Is Nothing Then
        On Error GoTo bm_SafeExit
        'TURN OFF EVENTS IF YOU ARE GOING TO WRITE A VALUE INTO THE WORKSHEET!
        Application.EnableEvents = False
        Dim uCol As Long, f As Range
        If Application.CountIf(Rows(1), "updated") Then
            uCol = Application.Match("updated", Rows(1), 0)
            For Each f In Intersect(Target, Range("A:DX"))
                If f.Row > 1 Then _
                    Cells(f.Row, uCol) = Now
            Next f
        Else
            MsgBox "'Updated' header not found!"
        End If
    End If
bm_SafeExit:
    Application.EnableEvents = True
End Sub

That should survive multiple updates (e.g. when pasting values). The problem I see is that is the Updated column is being shifted around, presumably through inserting columns or the like, then the change routine is going to run.

Upvotes: 0

PeterT
PeterT

Reputation: 8557

In a case such as this, I run into far fewer problems when I simply loop through the available cells to find the column header. Using the .Find method also works, but is less "tunable" to my needs in a custom application.

Public Function FindColumn(header As String) As Long
    Dim lastCol As Long
    Dim headerCol As Long
    Dim i As Long
    Dim sh As Worksheet

    Set sh = ThisWorkbook.Sheets("VTO2 Labor")
    lastCol = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
    headerCol = 0
    For i = 1 To lastCol
        If sh.Cells(1, i).Value = header Then
            headerCol = i
        End If
    Next i
    FindColumn = headerCol
End Function

Upvotes: 0

Related Questions