Two questions about VBA in excel: 1. Return a column name and return old value of a cell

Question

I'm creating a spreadsheet with logdetails of another sheet with information that is changing constantly and I have to keep tracking the changes. I was able to record into the logdetails spreadsheet part of the changes

but not the column name (based on the cell address and the old value).

Here it is my VBA code so far.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If ActiveSheet.Name <> "logdetails" Then

Application.EnableEvents = False

Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & "-" & Target.Address(0, 0)
Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Target.Value
Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Environ("username")
Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Now
Sheets("logdetails").Columns("A:H").AutoFit

Application.EnableEvents = True

End If

End Sub

what do you mean by column name, the value of the cell in row 1 of the target column ? — CDP1802, Dec 27 '22 at 19:31
Means that returns the column name based on the changed value in the cell. For example, Cell A1 has the value: reps-G151. It should return the column name of column G. — raphazzz, Dec 27 '22 at 20:40

MRC · Accepted Answer · 2022-12-27T20:49:23.130

First you need to save the old value somewhere through workbook event. The variable lastRng bellow will save the value of every active cell and it will be restored in case of change

Dim lastRng

Private Sub Workbook_Open()
    Set lastRng = ActiveCell
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    lastRng = Target.Value
End Sub

After, you add the next two lines

Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Target.Address
Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = lastRng

to complete your table as you desire. I didn't understand very well what you means by column name, but if you want the letter instead column number or cell address, you can find good solutions here in this question to convert one in another

All in all, your consolidated code will be like this:

Dim lastRng

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name <> "logdetails" Then

        Application.EnableEvents = False
        
        Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & "-" & Target.Address(0, 0)
        Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Target.Address
        Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = lastRng
        Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Target.Value
        Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Environ("username")
        Sheets("logdetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Now
        Sheets("logdetails").Columns("A:H").AutoFit
        
        Application.EnableEvents = True

    End If
End Sub

Private Sub Workbook_Open()
    Set lastRng = ActiveCell
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    lastRng = Target.Value
End Sub

Should I put the first chunk of code before the main code? And regarding your second question, instead of returning the address of the cell like A1, it would return the name of column A (like last_name). — raphazzz, Dec 27 '22 at 20:46
@raphazzz, I edited my answer to give you the whole code. If your code was working, as you told us, you need to put that in the same place (which is Microsoft Excel Object > Thisworkbook, and then, in the first command box, select Workbook) — MRC, Dec 27 '22 at 20:53
@raphazzz...sorry. About the second part of your question it is not clear yet...what you mean Column A (like last_name)? Is it the value of the first row in that column? The letter A or the number 1? Could you give an example with the columns of your question? Thanks! — MRC, Dec 27 '22 at 21:45
everything is working, but the column header. It returns $H$153 (cell address) instead of the name where the change was made, like status — raphazzz, Jan 23 '23 at 17:02

VBasic2008 · Answer 2 · 2023-03-14T09:07:53.877

A Workbook Sheet Change: Log Changes in Multiple Worksheets

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Const LogName As String = "logdetails"
    Const DST_COLUMNS_COUNT As Long = 6
    
    On Error GoTo ClearError
    
    If Sh.Name = "logdetails" Then Exit Sub
    
    Dim twsName As String: twsName = Sh.Name
    Dim usName As String: usName = Environ("USERNAME")
    Dim cTime As String: cTime = Now
    
    Dim nDict As Object: Set nDict = DictRangeAddressAndFormulas(Target)
    
    Application.EnableEvents = False
    
    Dim oDict As Object
    Application.Undo
        Set oDict = DictRangeAddressAndFormulas(Target)
    Application.Undo

    Dim drCount As Long, nKey
    
    For Each nKey In nDict.Keys
        drCount = drCount + UBound(nDict(nKey), 1)
    Next nKey

    Dim dData() As Variant: ReDim dData(1 To drCount, 1 To DST_COLUMNS_COUNT)
    
    Dim sr As Long, sc As Long, dr As Long, nString As String, oString As String
    
    For Each nKey In nDict.Keys
        Debug.Print nKey, nDict(nKey)(1, 1), oDict(nKey)(1, 1)
        For sr = 1 To UBound(nDict(nKey), 1)
            For sc = 1 To UBound(nDict(nKey), 2)
                nString = CStr(nDict(nKey)(sr, sc))
                oString = CStr(oDict(nKey)(sr, sc))
                If StrComp(nString, oString, vbBinaryCompare) <> 0 Then
                    dr = dr + 1
                    With Sh.Range(nKey).Cells(sr, sc)
                        dData(dr, 1) = twsName & "-" & .Address(0, 0)
                        dData(dr, 2) = Split(.Address, "$")(1)
                    End With
                    dData(dr, 3) = oDict(nKey)(sr, sc)
                    dData(dr, 4) = nDict(nKey)(sr, sc)
                    dData(dr, 5) = usName
                    dData(dr, 6) = cTime
                End If
            Next sc
        Next sr
    Next nKey
    
    Dim dws As Worksheet: Set dws = Me.Sheets(LogName)
    Dim dlCell As Range: Set dlCell = dws.Cells(dws.Rows.Count, "A").End(xlUp)
    Dim drg As Range: Set drg = dlCell.Offset(1).Resize(dr, DST_COLUMNS_COUNT)
    
    drg.Value = dData
    
    drg.EntireColumn.AutoFit
    
ProcExit:
    On Error Resume Next
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
    Resume ProcExit
End Sub

Function DictRangeAddressAndFormulas( _
    ByVal rg As Range) _
As Object
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim arg As Range
    For Each arg In rg.Areas
        dict(arg.Address) = GetRangeFormulas(arg)
    Next arg
    Set DictRangeAddressAndFormulas = dict
End Function

Function GetRangeFormulas( _
    ByVal rg As Range) _
As Variant
    Dim Data() As Variant
    If rg.Rows.Count * rg.Columns.Count = 1 Then ' one cell
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Formula
    Else ' multiple cells
        Data = rg.Formula
    End If
    GetRangeFormulas = Data
End Function

Two questions about VBA in excel: 1. Return a column name and return old value of a cell

2 Answers2

A Workbook Sheet Change: Log Changes in Multiple Worksheets