Home > Blockchain >  I have code that logs changes into a new sheet. How can I add code that will take the user to the mo
I have code that logs changes into a new sheet. How can I add code that will take the user to the mo

Time:04-29

I currently have code that logs any changes made into a separate change log sheet. I need to add in code that takes the user to that newest entry in the change log so that they have to put in a note for why they changed it. I was exploring this option of being taken to that entry or having a pop-up text box that appears when a change is made prompting the user to type in a note that will then be saved with that entry in the log.

Here's my working code:

Dim oldValue As String
Dim oldAddress As String

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim sSheetName As String
    Data = "Data"
    Dim ssSheetName As String
    MoreData = "MoreData"
    
    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 = oldValue
        Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Value
        Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ("username")
        Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Now

    If ActiveSheet.Name = Data Then
        Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & Data & "'!" & oldAddress, TextToDisplay:=oldAddress
    
    ElseIf ActiveSheet.Name = MoreData Then
        Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & MoreData & "'!" & oldAddress, TextToDisplay:=oldAddress
    End If

    Sheets("LogDetails").Columns("A:D").AutoFit
    Application.EnableEvents = True
    
    End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
    If Target.Count > 1 Then Exit Sub
    If Target.Count = 1 Then
        oldValue = Target.Value
    End If
    oldAddress = Target.Address
End Sub


CodePudding user response:

I couldn't resist to do a bit of refactoring:

It's always a good idea to create a seperate sub-routine for a work like this - and then call the routine from the worksheet_change-event.

Furthermore I am first creating an array with the values to log - and then write this array to the log-sheet. Usually this is for performance reasons - which is not the case for this logging.

But as you can see: it is much easier to read and understand the code - as the reader doesn't have to "walk" along the long code line to see what is happening.

By using a variable for the target range it is pretty easy to select it later.

Regarding your basic question: This code first asks the user for the comment with a input-box. If he/she doesn't give an answer, according cell will be highlighted and user again asked to put in a comment.

Put this into a normal module

Public Sub addLogEntry(rgCellChanged As Range, oldValue As String, oldAddress As String)

Dim wsChanged As Worksheet
Set wsChanged = rgCellChanged.Parent

Dim wsLogData As Worksheet
Set wsLogData = ThisWorkbook.Worksheets("LogDetails")

'we don't need logging on the logsheet
If wsChanged Is wsLogData Then Exit Sub


'Get comment from user
Dim commentChange As String
commentChange = InputBox("Please enter a comment, why you made this change.", "Logging")


Application.EnableEvents = False

'Collect data to log
Dim arrLogData(6) As Variant
arrLogData(0) = wsChanged.Name & " - " & rgCellChanged.Address(0, 0)
arrLogData(1) = oldValue
arrLogData(2) = rgCellChanged.Value
arrLogData(3) = Environ("username")
arrLogData(4) = Now
arrLogData(6) = commentChange '>>> adjust the column in case your comment column is not G



'get cell to enter log data
Dim rgLogData As Range
Set rgLogData = wsLogData.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

'write data
rgLogData.Resize(, 7).Value = arrLogData

'create hyperlink
wsLogData.Hyperlinks.Add rgLogData.Offset(, 5), Address:="", SubAddress:="'" & wsChanged.Name & "'!" & oldAddress, TextToDisplay:=oldAddress

'>>> optional: activate log sheet and select comment cell
'If user hasn't entered a comment, activate logsheet and cell
If LenB(commentChange) = 0 Then
    wsLogData.Activate
    MsgBox "Please enter the comment, why you made the change.", vbExclamation, "Logging"
    rgLogData.Offset(, 6).Select
End If

Application.EnableEvents = True

End Sub

And this is how your worksheet_change looks like

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    addLogEntry Target, oldValue, oldAddress
End Sub

Another advantage: if a code reader gets to this he/she immediately understands what will happen (a log entry will be added) - it is not necessary to read the whole code to understand it

  • Related