Tracking changes

[TG2812]

Hi,

I'm trying to track changes from the the sheet "Main" and document/track these changes back in sheet "Tracking".
However when I make some changes in sheet main, nothing happens in the sheet tracking. Any idea why?

The code I'm using is the following:


Dim oldAddress As String
Dim oldValue As String
-----------------------------------------------------------------

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

Dim sh As String
sh.name = "Main"

If WS.name <> Tracking Then
Application.EnableEvents = False


Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("A" & Target.Row)
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Range("B" & Target.Row)
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Range("C" & Target.Row)
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Range("D" & Target.Row)
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = oldValue
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Target.Value
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Environ("username")
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = Now
Sheets("Tracking").Hyperlinks.Add anchor:=Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 8), Address:="", SubAddress:="'" & WS.name & "'!" & oldAddress, TextToDisplay:=oldAddress
End If
Application.EnableEvents = True


End Sub

---------------------------------------------------------

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
On Error GoTo Err
oldValue = Target.Value
oldAddress = Target.Address

Err:
End Sub

 

[TG2812]

Any help would be greatly appreciated

 

[Logit]

.
This macro goes in ThisWorkbook module :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
x = Sheets.Count
ReDim arr(1 To x)
For i = 1 To UBound(arr)
    arr(i) = "Sheet " & i & " " & Sheets(i).Name
Next
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 6) = Array(Now(), Environ("UserName"), "", "", "", "wb Close")
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(, 6).Resize(, UBound(arr)) = arr
ActiveWorkbook.Save
End Sub


Private Sub Workbook_Open()
x = Sheets.Count
ReDim arr(1 To x)
For i = 1 To UBound(arr)
    arr(i) = "Sheet " & i & " " & Sheets(i).Name
Next
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 6) = Array(Now(), Environ("UserName"), "", "", "", "wb Open")
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(, 6).Resize(, UBound(arr)) = arr
End Sub

This goes in the Sheet Main module :

Private Sub Worksheet_Change(ByVal Target As Range)
    With Application
        .EnableEvents = False
        .Undo
        Sheets("Tracking").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(Now(), Environ("UserName"), Target.Address(0, 0), Target.Value)
        .Undo
        Sheets("Tracking").Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = Target.Value
        .EnableEvents = True
        Target.Offset(1).Activate
    End With
    x = Sheets.Count
ReDim arr(1 To x)
For i = 1 To UBound(arr)
    arr(i) = "Sheet " & i & " " & Sheets(i).Name
Next
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(, 6).Resize(, UBound(arr)) = arr
Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(, 7).Resize(, UBound(arr)) = ""


End Sub

In the TRACKING sheet, row #1 ... enter the following :

[Table="width:, class:head"][tr=bgcolor:#888888][th] [/th][th]

A​

[/th][th]

B​

[/th][th]

C​

[/th][th]

D​

[/th][th]

E​

[/th][th]

F​

[/th][th]

G​

[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]

1​

[/td][td]

Date / Time​

[/td][td]User[/td][td]Cell[/td][td]Old Value[/td][td]New Value[/td][td]Workbook Open
Workbook Close[/td][td]Sheet Names[/td][/tr]
[/table]

 

[TG2812]

Thanks.

Questions;
Why cant i keep the original code? This one seems much more complicated, no?
What is the code you came up with actually doing? When I'm changing a number in the worksheet "Main" -> nothing is getting reported in the sheet "Tracking"

 

[Logit]

.
Here is a link to download the sample workbook. I haven't edited the code or tabs to your worksheet names.

https://www.amazon.com/clouddrive/share/7hD3TryVvwCdjXmVSaOYlp6gFUtX2hRL5Wey4c8Y7Ba

I provided the sample project as a reference that you might be able to work off of.
Let me look at your code and see if I can determine what changes are required.

 

[Logit]

.
I was able to get everything working except the last line in your macro where it appears you are wanting to paste a link ?

Dim oldAddress As String
Dim oldValue As String
'-----------------------------------------------------------------


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


Dim ws As Worksheet
Dim rng As Range: Set rng = Application.Range("A:D")
Dim Column As Range

On Error Resume Next


If Not Target.Column <> 1 Or Not Target.Column <> 2 Or Not Target.Column <> 3 Or Not Target.Column <> 4 Then
    If sh.Name <> "Tracking" Then
            
        Application.EnableEvents = False
        
        
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("A" & Target.Row)
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Range("B" & Target.Row)
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Range("C" & Target.Row)
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Range("D" & Target.Row)
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = oldValue
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Target.Value
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Environ("username")
        Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = Now
        'Sheets("Tracking").Hyperlinks.Add anchor:=Sheets("Tracking").Range("A" & Rows.Count).End(xlUp).Offset(0, 8), Address:="", SubAddress:="'" & ws.Name & "'!" & oldAddress, TextToDisplay:=oldAddress
        
    
    End If
End If
Application.EnableEvents = True




End Sub


'---------------------------------------------------------


Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
On Error Resume Next
If sh.Name <> "Tracking" Then
    oldValue = Target.Value
    oldAddress = Target.Address
End If
End Sub

 

[Logit]

.
Here is a link to your edited workbook :

https://www.amazon.com/clouddrive/share/dISK1tpVSQqaH9fE0QEpD07Iq4oArcd24TTAcZmSAt5

 

[TG2812]

Many thanks! It works! the enableevents procedure was disabled and was preventing the macro from running.

Another question: I will need to add another column to ensure all changes are neutral (net 0).
Example: if I withdraw 2, I need to add 2 somewhere else -> balance equals 0

How can I embed this logic in the code and remind user that the the remaining balance is positive (or negative) and need to be fixed before closing workbook?

 

[Logit]

.
Hmmm ... you've lost me on that one.

Can you post your workbook to DROPBOX or GOOGLE CLOUD or AMAZON CLOUD .. something like that so I can see what it is you are doing ?

Provide a BEFORE and AFTER view of what you envision to help make it more understandable.

Thanks.

 

[TG2812]

Sorry but I have not got an access to these platforms. I will attempt to express the requirements herebelow.
Basically what I'm trying to attempt can be summarized in the below chart:

[TABLE="width: 738"]
<colgroup><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Reference[/TD]
[TD]Country[/TD]
[TD]Product Range[/TD]
[TD]Warehouse[/TD]
[TD]Production month[/TD]
[TD]Previous Quantity[/TD]
[TD]New Quantity[/TD]
[TD]Changes[/TD]
[TD] Balance[/TD]
[/TR]
[TR]
[TD]Peanut134SAZ[/TD]
[TD]Germany[/TD]
[TD]Food[/TD]
[TD]Cologne[/TD]
[TD="align: right"]Mar-19[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]4[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Butter23[/TD]
[TD]Germany[/TD]
[TD]Food[/TD]
[TD]Cologne[/TD]
[TD="align: right"]Mar-19[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]-2[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]Toast98YT[/TD]
[TD]Germany[/TD]
[TD]Food[/TD]
[TD]Cologne[/TD]
[TD="align: right"]Mar-19[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]-2[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]Pasta34ZSW[/TD]
[TD]UK[/TD]
[TD]Food[/TD]
[TD]London[/TD]
[TD="align: right"]Apr-19[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]-5[/TD]
[TD="align: right"]5[/TD]
[/TR]
</tbody>[/TABLE]

Requirements;

#1: The remaining balance for a given country, product range, warehouse and production month always need to be equal to 0.
Example: I increase my production of Peanut134SAZ by 4 in March. I need to reduce the Butter23 by 2 and Toast98YT by 2. My remaining balance equals 0 as the surplus created by Butter134SAZ has been taken out from other references.

#2: The remaining balance for a given country, product range, warehouse and production month does not equal to 0.
Example: I reduce the production of Pasta34SW by 5 in April. I consequently need to increase my production on other products during April to bring my remaining balance down to 0. A message should appear to the user before closing workbook if remaining balance for a particular product is not equal to 0.

Note: Production will be impacted in worksheet "Main". Changes will be listed under sheet "Tracking". If we could depart from the code pasted above, this would be great. I believe a few line of codes should be added but I'm not knowledgeable enough to carry on by my own.


Ideally once the tracking table is complete and the user finishes completing all necessary adjustments, it would be nice to this table via Outlook (just the email window with table copied).


Thanks a lot in advance for your help.