VBA code to track changes in workbook

[Fwiz]

hi,

I have a specific range within my worksheet ie d9:v20

when any of these cells within this range are changed - ie changed being defined as changed the content of the cell and saved the workbook.

if the content of cells are changed then I'd like my code to write up the event in a separate worksheet (in same workbook) showing name, date of change and what the cell was changed to and from.

is this possible?



thanks

 

[Fwiz]

R,

I'ved added inthe code and saved the file, I'm getting error "run time 9, subscript out of range ...

Sub Managementtest(LiveWS As String, AuditWS As String)

Dim iRow As Integer
Dim iCol As Integer
Dim iLastRow As Long

For iRow = 25 To 46
For iCol = 6 To 186
If Sheets(AuditWS).Cells(iRow, iCol).Value <> Sheets(LiveWS).Cells(iRow, iCol).Value Then
iLastRow = Sheets(AuditWS).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(AuditWS).Cells(iLastRow + 1, 1) = AlphaCol(iCol) & CStr(iRow) & " changed"
Sheets(AuditWS).Cells(iLastRow + 1, 2) = Sheets(AuditWS).Cells(iRow, iCol).Value
Sheets(AuditWS).Cells(iLastRow + 1, 3) = Sheets(LiveWS).Cells(iRow, iCol).Value
Sheets(AuditWS).Cells(iRow, iCol) = Sheets(LiveWS).Cells(iRow, iCol).Value
End If
Next iCol
Next iRow

iLastRow = Sheets(AuditWS).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(AuditWS).Cells(iLastRow + 1, 1) = "Workbook opened by " & Environ("USERNAME") _
& " on " & Format(Now(), "dd/mm/yyyy") & " at " & Format(Now(), "hh:nn:ss")

Eend Sub

I am getting error on : B] If Sheets(AuditWS).Cells(iRow, iCol).Value <> Sheets(LiveWS).Cells(iRow, iCol).Value ?

 

[Ruddles]

I'ved added inthe code and saved the file, I'm getting error "run time 9, subscript out of range ...

If Sheets(AuditWS).Cells(iRow, iCol).Value <> Sheets(LiveWS).Cells(iRow, iCol).Value Then

Check in your Workbook_BeforeSave routine that the worksheet names you use in your call to Managementtest are correct. Check carefully for leading/trailing spaces. They have to match exactly and the 'audit' worksheets have to already exist.

Eend Sub

D'oh!

 

[Ruddles]

...the 'audit' worksheets have to already exist.

Is that a problem? Would you like me to create the audit sheet if it doesn't already exist?

 

[Fwiz]

R,

there was an error on the code - name not matching my sheet description, I've corrected this now, - I've added another worksheet into the equation and set the worksheet names in the variables - I'm getting the same error again....

is there a limitation on the setting the variables for the worksheets? - when I step out the 4th worksheet this will work fine on the 3, I've checked the names on of the worksheet so this seems ok

any thoughts?

 

[Ruddles]

Post your Workbook_BeforeSave code here and let me have a look at it. Remember that your 'audit' sheets have to be created manually in the current version of the code. Check that each data sheet has an audit sheet allocated to it and that the names match the ones in your Workbook_BeforeSave code.

Failing that I'll PM you my work address and I can check it if you can get it to me in the next hour and a half.

 

[Fwiz]

thanks R,

I've posted this to you email -

thanks

 

[jhedges]

Ruddles,

Is there away to do this with a ever changing table of data? Meaning I have a table called "Table1", which has 26 columns(fixed) but will have ever changing rows as we add or delete rows.

Thanks
Jason

 

[ajay_gajree]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw              As Long
Dim strAddress      As String
Dim strWS           As String
Dim strUserName     As String
Dim dtmTime         As Date
Dim val         As Variant
    
    If Intersect(Target, Cells) Is Nothing Then Exit Sub
    
    dtmTime = Now()
    val = Target.Value
    strAddress = Target.Address
    strWS = ActiveSheet.Name
    strUserName = Application.UserName
    
    Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
    With Sheets("Log Sheet")
        .Cells(Rw, 1) = strUserName
        .Cells(Rw, 2) = strWS
        .Cells(Rw, 3) = strAddress
        .Cells(Rw, 4) = val
        .Cells(Rw, 5) = dtmTime
    End With
End Sub

I have amended the code to the above so that I can capture any change in the whole sheet.

If I wanted to use this to track changes in the whole workbook do I need to put this code into every sheet module? Or is there a way to make this workbook wide?

Thanks all!

 

[xtreme247]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw              As Long
Dim strAddress      As String
Dim strWS           As String
Dim strUserName     As String
Dim dtmTime         As Date
Dim val         As Variant
    
    If Intersect(Target, Cells) Is Nothing Then Exit Sub
    
    dtmTime = Now()
    val = Target.Value
    strAddress = Target.Address
    strWS = ActiveSheet.Name
    strUserName = Application.UserName
    
    Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
    With Sheets("Log Sheet")
        .Cells(Rw, 1) = strUserName
        .Cells(Rw, 2) = strWS
        .Cells(Rw, 3) = strAddress
        .Cells(Rw, 4) = val
        .Cells(Rw, 5) = dtmTime
    End With
End Sub

I have amended the code to the above so that I can capture any change in the whole sheet.

If I wanted to use this to track changes in the whole workbook do I need to put this code into every sheet module? Or is there a way to make this workbook wide?

Thanks all!

Hi, how can this code be modified to capture the old value of the cell? I am looking to capture the old value and the value it was changed to in addition to the cell address, who changed it, and when they changed it. Thanks in advance.

 

[SydneyGeek]

I don't think you can capture the old value.
You can in Access because there's a BeforeUpdate event, and controls have an OldValue property. In Access, the Change event only fires once the change is made, and the old value is lost.
I'm happy to be proved wrong on this, but I think you might be out of luck.

Denis