VBA code to track changes in workbook

Fwiz

Board Regular
Joined
May 15, 2007
Messages
241
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
 
Ahhhh I see, I'm missing the point!! thanks I see - it works ok.

just one thing - this saves the cell reference as "Cell(9,4)" is there a way of just stating D9 as reference?
 
Upvote 0

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Just "ok"? :)

I was hoping to get away with that because it was easier but yes, that's a simple change. Replace the ThisWorkbook code with this:-
Code:
Option Explicit
 
Const LiveWS As String = "Sheet1"
Const AuditWS As String = "Audit"
 
Private Sub Workbook_Open()
 
  Dim iRow As Integer
  Dim iCol As Integer
  Dim iLastRow As Long
  
  For iRow = 9 To 20
    For iCol = 4 To 22
      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")
  ActiveWorkbook.Save
  
End Sub
 
Public Function AlphaCol(argColumn As Integer) As String
 
  Dim intPrefix As Integer
  Dim strPrefix As String
 
  intPrefix = 0
  Do Until argColumn <= 26
    intPrefix = intPrefix + 1
    argColumn = argColumn - 26
  Loop

  If intPrefix > 0 Then strPrefix = Chr(intPrefix + 64)
 
  AlphaCol = strPrefix & Chr(argColumn + 64)
  
End Function
 
Upvote 0
Ruddles - man this is cool,

I've change the event to run on before save event - this works well as i think using open event when user is read only, i think this could encounter problems,

using :Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Is there a way I could add worksheet name to the reference?
 
Upvote 0
Any data that's available to VBA at the time the code runs, you can put in the log entry. Try this:-
Code:
        Sheets(AuditWS).Cells(iLastRow + 1, 1) = [B][COLOR=red]ActiveWorkbook.Name [COLOR=red]&[/COLOR][/COLOR][COLOR=red] " "[/COLOR][COLOR=red] &[/COLOR][/B] [COLOR=blue][B]LiveWS & " " &[/B][/COLOR] AlphaCol(iCol) & CStr(iRow) & " changed"
Is that what you mean?
 
Upvote 0
Cool that works, I've basically amend parts of the code to suit my needs, just one question I'm looking at having this code attached to 2 different worksheets - ie history recorded from 2 sheets -

is it better to have audit sheet per worksheet?

how do i get around the "option Explicit" - this declares LiveWS as a specific sheet - do i just put the code in each worksheet or is there another way?
 
Upvote 0
The best way is to make the code a generic subroutine and pass the sheet names to it as parameters. Try this:-
Code:
Option Explicit
 
Private Sub Workbook_Open()
 
  Call Log_Sheet("Sheet1", "Audit")
  Call Log_Sheet("Sheet2", "Audit2")
 
  ActiveWorkbook.Save
 
End Sub
 
Private Sub Log_Sheet(LiveWS As String, AuditWS As String)
 
  Dim iRow As Integer
  Dim iCol As Integer
  Dim iLastRow As Long
 
  For iRow = 9 To 20
    For iCol = 4 To 22
      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) = ActiveWorkbook.Name & " " & LiveWS & " " & 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")
 
End Sub
 
Public Function AlphaCol(argColumn As Integer) As String
 
  Dim intPrefix As Integer
  Dim strPrefix As String
 
  intPrefix = 0
  Do Until argColumn <= 26
    intPrefix = intPrefix + 1
    argColumn = argColumn - 26
  Loop
 
  If intPrefix > 0 Then strPrefix = Chr(intPrefix + 64)
  AlphaCol = strPrefix & Chr(argColumn + 64)
 
End Function
I'm conscious that I'm still posting 'my' version of the code rather than your version which runs before save. If you'd like to let me see your code, I shall work with that in future.
 
Upvote 0
This is my code:

in this workbook i have:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Call Managementtest

End Sub

then on module i have:

Option Explicit

Const LiveWS As String = "RR J to J"
Const AuditWS As String = "Audit"



Sub Managementtest()

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) = "Saved amendments to " & LiveWS & " by " & Environ("USERNAME") _
step out .. test 'Sheets(AuditWS).Cells(iLastRow + 1, 1) = ActiveWorkbook.Name & " " LiveWS & "Cell Refer " & AlphaCol(iCol) & CStr(iRow) & " changed"
step out test 2 'Sheets(AuditWS).Cells(iLastRow + 1, 1) = "Workbook opened by " & Environ("USERNAME") _
& " on " & Format(Now(), "dd/mm/yyyy") & " at " & Format(Now(), "hh:nn:ss")


End Sub

Public Function AlphaCol(argColumn As Integer) As String

Dim intPrefix As Integer
Dim strPrefix As String

intPrefix = 0
Do Until argColumn <= 26
intPrefix = intPrefix + 1
argColumn = argColumn - 26
Loop

If intPrefix > 0 Then strPrefix = Chr(intPrefix + 64)

AlphaCol = strPrefix & Chr(argColumn + 64)

End Function

basically, I have 2 sheets 1 "RR J to J" and the second is "RR J to D", the data on each sheet differs so cannot use 1 audit sheet to compare and log data (i think?) - I'm a little confused on how the generic subroutine would work and lost? - I thought I could have a tracker for each sheet but the call log sheet thing has confused me somewhat (my lack of understanding)
 
Upvote 0
My first version relied on fixed sheet names in the worksheet event handler. If you want to run the same routine against multiple sheets, the code needs to be able to accept variable names. The best way to do this is to pass the sheet names in to the routine as parameters and then in the worksheet event handler we call the routine with the names of the sheets we want to use as the 'live' sheet and the 'audit' sheet. (You can call the 'audit' sheets whatever you like provided their names match those in the CALL statements.)

See if you can read through this code and follow how it works:-
Code:
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
  Call Managementtest("[COLOR=red][B]RR J to J[/B][/COLOR]", "[COLOR=blue][B]Audit[/B][/COLOR]")
  Call Managementtest("[COLOR=red][B]RR J to D[/B][/COLOR]", "[COLOR=blue][B]Audit2[/B][/COLOR]")
 
End Sub
 
Sub Managementtest([COLOR=red][B]LiveWS[/B][/COLOR] As String, [B][COLOR=blue]AuditWS[/COLOR][/B] 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")
 
End Sub
 
Public Function AlphaCol(argColumn As Integer) As String
 
  Dim intPrefix As Integer
  Dim strPrefix As String
 
  intPrefix = 0
  Do Until argColumn <= 26
    intPrefix = intPrefix + 1
    argColumn = argColumn - 26
  Loop
 
  If intPrefix > 0 Then strPrefix = Chr(intPrefix + 64)
 
  AlphaCol = strPrefix & Chr(argColumn + 64)
 
End Function
 
Upvote 0
ooooooooooooooh right, I see now, so rather that have this code to be copied multiple times for different worksheets, this change basically takes into consideration variables in terms that we can specific if one sheet was changed it then logs it on to the respective sheet as set in the variables. oh my lord how did i not see that.

I'm gonna make this change and post back on monday, will let you know how i get on.

many thanks for your help so far - you've been exceptional. As I'm self taught on the basics sometimes i don't quite fully understand all of it, even though i have a knack of finding what I need and modifying the code myself - strange huh?

much appreciated - I've learnt alot today.
 
Upvote 0
I've learned a lot just by reading code and comparing it to what it does. Some people have a knack of writing code which is easy to read, some don't. Sometimes you need to know what code is supposed to be doing in order to decipher it. Sometimes it's almost impossible to understand how a piece of code works, in which case just treat it as a 'black box' into which you throw some data and it just works.
 
Upvote 0

Forum statistics

Threads
1,223,897
Messages
6,175,270
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top