Wijzigingen bijhouden

[Shorty75]

Hoi Allemaal,

Ik wil in een sheet de wijzigingen bijhouden die in het werkblad worden gemaakt.
Dat lukt prima, maar alleen de wijziging wordt bijgehouden.
Is het ook mogelijk om bij te houden wat er stond voor dat de wijziging werd gemaakt?
Dat zou echt super zijn.
Ik hoop dat jullie kunnen helpen
Alvast bedankt


Het scripje dat ik gebruik is:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
With Sheets(1).Range("A65536").End(xlUp)
.Offset(1, 0).Value = Application.UserName
.Offset(1, 1).Value = Sh.Name
.Offset(1, 2).Value = Target.Address(False, False)
.Offset(1, 3).Value = Now
.Offset(1, 4).Value = Target.Value
End With
Application.EnableEvents = True
End Sub

 

[HSV]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sNew, sOld
Application.EnableEvents = False
   sNew = Target
   Application.Undo
   sOld = Target
   Target = sNew
 Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 6) = Array(Application.UserName, Sh.Name, Target.Address(False, False), Now, sNew, sOld)
Application.EnableEvents = True
End Sub

 

[Shorty75]

Hoi HSV,

Dank je wel. Dat is precies wat ik zocht. en ook zo snel.
Jouw scriptje is nog compacter dan wat ik had. Niveau verschil moet er zijn zeg ik dan maar.

Ik heb alleen sNew en sOld nog even omgedraaid, dat vond ik iets logischer lezen in de tabel.

Klein dingetje nog.
De gegevens komen nu in een tabelvorm te staan in Sheet1. Zou je er nog voor kunnen zorgen dat de nieuwste altijd bovenaan komt te staan?
Ik wil in de bovenste rij (rij 1) gebruiken voor een tabelkop

Voor nu alvast enorm bedankt

 

[HSV]

Voeg deze regel boven 'application.enabbleevents = true' toe.

 Sheets(1).Cells(1).CurrentRegion.Sort Sheets(1).Range("d1"), 2, , , , , , xlyes

 

[Shorty75]

Dank je wel.

Toch nog een dingetje waar het op misloopt.

In één van de sheets wil ik soms een nieuwe regel invoegen. Hier loopt het scriptje op fout, bij sOld en sNew.
Waarschijnlijk is de wijziging te groot om op te geven??

Heb je daar toevallig nog een oplossing voor, daarna hou ik op

 

[HSV]

De 'on error resume next' weer toevoegen, of:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sNew, sOld
'On Error Resume Next
Application.EnableEvents = False
If Target.Count = 1 Then
     sNew = Target.Value
     Application.Undo
     sOld = Target.Value
     Target = sNew
   With Sheets(1)
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 6) = Array(Application.UserName, Sh.Name, Target.Address(False, False), Now, sNew, sOld)
      .Cells(1).CurrentRegion.Sort .Range("d1"), 2, , , , , , 1
   End With
 End If
Application.EnableEvents = True
End Sub

De wijzigingen worden niet weggeschreven!

 

[Shorty75]

Beste HSV,

Bij het laatste script wordt er inderdaad een regel toegevoegd en gaat hij verder
Dat is wat ik zoek.

Dank je wel voor je hulp

 

[Shorty75]

Wijzigingen bijhouden en het blad beveiligen tegen overschrijven

Het laatste script werkt prima. Toch heb ik nog een aanvullende vraag.

Situatie:
Als er een wijziging in één van de tabbladen wordt gemaakt, wordt dat in het eerste tabblad weggeschreven. (dit tabblad noem ik even "Logging").
Daarna wordt de volgorde opnieuw geordend van nieuw naar oud.

Het script werkt alleen niet als ik op het tabblad "Logging" een beveiliging zet.
Ik heb het ook geprobeerd met een apart script op het tabblad "logging", waarbij de ingevulde cel geblokkeerd worden als zij gevuld worden, maar dat werkt niet op de één of andere manier.


Wat ik graag zou willen is dat naast dat er wijzigingen in tabbladen in het tabblad "Logging" worden weggeschreven en dat het wordt gerangschikt,
Dat het tabblad "logging" beveiligd is tegen wijzigingen door de gebruiker.


Het volgende script had HSV al voor mij gemaakt (deze regelt het wegschrijven en het opnieuw ordenen)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sNew, sOld
'On Error Resume Next
Application.EnableEvents = False
If Target.Count = 1 Then
sNew = Target.Value
Application.Undo
sOld = Target.Value
Target = sNew
With Sheets(1)
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 6) = Array(Application.UserName, Sh.Name, Target.Address(False, False), Now, sNew, sOld)
.Cells(1).CurrentRegion.Sort .Range("d1"), 2, , , , , , 1
End With
End If
Application.EnableEvents = True
End Sub

Wie zou mij hiermee kunnen helpen?

Alvast enorm bedankt

 

[HSV]

Beveilig het zo

Sheets("logging").protect "wachtwoord hier", userinterfaceonly = true

Of:

sheets("logging").protect "wachtwoord hier",,,,true