VBA Audit Trial for warehouse item manager

[sk8_chris20]

Greetings all I am pretty much new here and have been trying to build something helpful for myself at work. I got everything working apart from a few tiny bits I can't get my head around. If someone could help I would be super grateful. So basically I have built an Item Manager in excel for our small warehouse and can't get an audit trial to do what I want from it which is to reference an item code and GRN to every change. When a change occurs audit gives me a user name, computer name, cell address where change occurred, value before and after the change as well as date and time and sheet name. For every change I need VBA to be able to reference "item code" and "GRN" from the row that change occurred. This is what I have so far and if anyone can help thank you in advance.

Dim PreviousValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Errb As Integer
On Error GoTo ErrTrap:
If Target.Value <> PreviousValue Then
With Sheets("AuditLog").Cells(65000, 1).End(xlUp)
.Offset(1, 0).Value = Application.UserName
.Offset(1, 1).Value = Environ$("computername")
.Offset(1, 2).Value = "changed cell"
.Offset(1, 3).Value = Target.Address
.Offset(1, 4).Value = "To list referance to item code from column C"
.Offset(1, 5).Value = "To list referance to GRN from column B"
.Offset(1, 6).Value = PreviousValue
.Offset(1, 7).Value = Target.Value
.Offset(1, 8).Value = Now()
.Offset(1, 9).Value = ActiveSheet.Name
End With
End If
Exit Sub
ErrTrap:
ErrNum = Err

If ErrNum = 13 Then
'*** Multiple cells have been selected, treat them as one merged group*****
Resume Next
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub

[Kaper]

My vision is:
- no public variables
- changes in several cells at once allowed (may be someone copies data from the other sheet?)
- but not allowed multiple areas (non-contignous ranges) - I don't think it's a common situation, the user is informed and old values are restored
- approach:
- store new data in an array with the same structure (rows/cols) as target
- restore previous values just before event Change (undo)
- compare cell by cell stored with previous
- list each changed cell with all additional information in logsheet
- restore new (undo again)

PS. I can see I missed sheetname in column 10. you may add this - hope it's not a big deal, but you may also think about using thisWorkbook: Workbook_SheetChange event instead of given_sheet Worksheet_Change, to cover all sheets in one event ahndler - not separate handler for each sheet.

Please Login or Register  to view this content.

[JEC.]

To save some space

Please Login or Register  to view this content.

[sk8_chris20]

My vision is:
- no public variables
- changes in several cells at once allowed (may be someone copies data from the other sheet?)
- but not allowed multiple areas (non-contignous ranges) - I don't think it's a common situation, the user is informed and old values are restored
- approach:
- store new data in an array with the same structure (rows/cols) as target
- restore previous values just before event Change (undo)
- compare cell by cell stored with previous
- list each changed cell with all additional information in logsheet
- restore new (undo again)

PS. I can see I missed sheetname in column 10. you may add this - hope it's not a big deal, but you may also think about using thisWorkbook: Workbook_SheetChange event instead of given_sheet Worksheet_Change, to cover all sheets in one event ahndler - not separate handler for each sheet.

Please Login or Register  to view this content.

Thank you so much, you are a live saver. It works beautifully
My file has many sheets but I only need that to work in 2 that's why it was done that way as I don't want/need an audit for 6 other tabs lol only 2 people have access to those so it should be fine where's the stock is important one.
Thank you again

[sk8_chris20]

To save some space

Please Login or Register  to view this content.

This is really helpful thank you so much

[Kaper]

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.

Also, you may not be aware that you can thank those who have helped you by clicking the small star icon located in the lower left corner of the post in which the help was given. By doing so you can add to the reputation(s) of those who helped.

[sk8_chris20]

Not sure if I can ask here considering this thread has been solved.
However, I have recently added a VBA data entry form to the sheet and was wondering if there is any way that the above code posted by Kaper could also track entries/changes to the sheet done via the form. Not sure if this is possible, I have tried to figure it out myself but didn't have any luck. Here is the pic of what the sheet and the form look like Attachment 802365

Also my current VBA codes
This is the one for the Form

Private Sub CommandButton1_Click()
Dim sht As Worksheet, sht1 As Worksheet, lastrow As Long
''''''''Validation''''''''

If Me.TextBox1.Value = "" Then
MsgBox "Please enter a correct location", vbCritical
Exit Sub
End If

If VBA.IsNumeric(Me.TextBox2.Value) = False Then
MsgBox "Please enter a correct GRN", vbCritical
Exit Sub
End If

If Me.TextBox3.Value = "" Then
MsgBox "Please enter a correct item code", vbCritical
Exit Sub
End If

If Me.OptionButton1.Value = False And Me.OptionButton2.Value = False And Me.OptionButton3.Value = False And Me.OptionButton4.Value = False Then
MsgBox "Please select status", vbCritical
Exit Sub
End If


If Me.TextBox6.Value = "" Then
MsgBox "Please enter transaction date", vbCritical
Exit Sub
End If

If Me.TextBox7.Value = "" Then
MsgBox "Please enter quantity", vbCritical
Exit Sub
End If

''''''''End of Validation''''''''
Set sht = ThisWorkbook.Sheets("WH STOCK Test")

lastrow = sht.Range("a" & Rows.Count).End(xlUp).Row + 1


''''sh.unprotect code - if ever I needed''''
With sht

.Range("A" & lastrow).Value = Me.TextBox1.Value
.Range("B" & lastrow).Value = Me.TextBox2.Value
.Range("C" & lastrow).Value = Me.TextBox3.Value
.Range("D" & lastrow).Value = Me.TextBox4.Value
.Range("G" & lastrow).Value = Me.TextBox6.Value
.Range("I" & lastrow).Value = Me.TextBox7.Value
.Range("K" & lastrow).Value = Me.TextBox9.Value

''''sh.protect code - if ever I needed''''

End With
sht.Activate
If Me.OptionButton1.Value = True Then sht.Range("J" & lastrow).Value = "APPROVED"
If Me.OptionButton2.Value = True Then sht.Range("J" & lastrow).Value = "ON HOLD"
If Me.OptionButton3.Value = True Then sht.Range("J" & lastrow).Value = "REJECT"
If Me.OptionButton4.Value = True Then sht.Range("J" & lastrow).Value = "QUARANTINE"

Exit Sub


End Sub

Private Sub CommandButton2_Click()
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox6.Value = ""
Me.TextBox7.Value = ""
Me.TextBox9.Value = ""

Me.OptionButton1.Value = False
Me.OptionButton2.Value = False
Me.OptionButton3.Value = False
Me.OptionButton4.Value = False

End Sub

And the one for Audit, I have tried changing few bits but couldn't make it work with the form

Private Sub CommandButton1_Click()
add_frm.Show
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("AuditLog").Unprotect Password:="32849217"
Dim i As Long, j As Long, k As Long, arr As Variant
On Error GoTo ErrTrap:
If Target.Areas.Count > 1 Then
Application.EnableEvents = True
Application.EnableEvents = True
MsgBox "sorry, you can change only one contignous range at once, old values restored", vbCritical
Else
If Target.Cells.Count > 1 Then
arr = Target.Value
Else
ReDim arr(1 To 1, 1 To 1)
arr(1, 1) = Target.Value
End If
Application.EnableEvents = False
Application.Undo
With Sheets("AuditLog")
k = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If arr(i, j) <> Target.Cells(i, j) Then
Debug.Print Target.Cells(i, j).Address, Target.Cells(i, j), arr(i, j)
.Cells(k, 1) = Application.UserName
.Cells(k, 2).Value = Environ$("computername")
.Cells(k, 3).Value = "changed cell"
.Cells(k, 4).Value = Target.Cells(i, j).Address
.Cells(k, 5).Value = Cells(Target.Cells(i, j).Row, "C").Value ' "To list referance to item code from column C"
.Cells(k, 6).Value = Cells(Target.Cells(i, j).Row, "B").Value ' "To list referance to GRN from column B"
.Cells(k, 7).Value = Cells(Target.Cells(i, j).Row, "D").Value ' "To list referance to LOT from column D"
.Cells(k, 8).Value = Target.Cells(i, j)
.Cells(k, 9).Value = arr(i, j)
.Cells(k, 10).Value = Now()
.Cells(k, 11).Value = ActiveSheet.Name
k = k + 1
End If
Next j, i
End With
Application.Undo ' this will ReDo last UnDo in case if I forget later !!! :-) !!!
Application.EnableEvents = True
Sheets("AuditLog").Protect Password:="32849217", UserInterfaceOnly:=True
Sheets("AuditLog").EnableAutoFilter = True
Sheets("AuditLog").AllowSorting = True
End If
Exit Sub
ErrTrap:
' keep events enabled reminder
Application.EnableEvents = True
' other errors could be also handled here


End Sub