write changes in log

[Ger]

Hello,

I "found" this vba code to log changes. It works fine if 1 cell is changed, but if several cells are changed simultaneous an error occurs.
What must i edit to make it work?

[VBA]
[FONT='Verdana','sans-serif']Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)[/FONT]
If target.row > 203 and target.row < 284 and target.column > 4 and target.column < 394 then
[FONT='Verdana','sans-serif']
If Target.Value <> PreviousValue Then
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
Application.UserName & " verandert cel " & Target.Address _
& " in werkblad ' " & Me.Name & " ' van " & " ' " & PreviousValue & " ' " & "naar " & " ' " & Target.Value & " ' " & " op tijdstip " & Time & " en datum " & Date
End If[/FONT]
End if
[FONT='Verdana','sans-serif']
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub[/FONT]
[/VBA]

Ger

[Ger]

In the meantime i understand that it isn't easy to get the result using this code. I found this new code. the problem with this code is that the cell validation results in an error the first time a valid value is entered. If the pulldown menu is used the value will be accepted the next time. Only problem is is that there are 367 valid values.
Anyone an idea?
[VBA]
Dim OldVals As New Dictionary
Private Sub Worksheet_Activate()
Dim cell As Range
For Each cell In Range("E204:OC283")
OldVals(cell.Address) = cell.Value
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
tekst = ""
naam = Application.UserName
For Each cell In Target
If Target.Row > 203 And Target.Row < 284 And Target.Column > 4 And Target.Column < 394 Then
nw = cell.Value
ad = cell.Address
blad = Me.Name
ow = ""
If OldVals.Exists(cell.Address) Then
ow = OldVals(cell.Address)
End If
tekst = tekst & "naam: " & naam & " " & "werkblad: " & blad & " " & "cell: " & " " & ad & "datum en tijd: " & " " & Now & " " & "oude waarde: " & " " & ow & " " & "nieuwe waarde: " & nw & vbLf
End If
OldVals(cell.Address) = cell.Value
Next
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = tekst
End Sub

[/VBA]

Ger

[snb]

crosspost

http://www.worksheet.nl/forumexcel/v...ge-loggen.html

[Ger]

You're right.

I also posted my question on a dutch site (advised by a mentor in a previous question). I neglected to include the link.

Sorry.

My entry on the dutch side is deleted.

http://www.worksheet.nl/forumexcel/v...ge-loggen.html
Ger

[Kenneth Hobs]

Try using Intersect().

Here is a method I have used for audit logging.

[VBA]'VOG II,http://www.mrexcel.com/forum/showthr...61#post1666961
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long, tc As Integer, rTC As Range
Dim cell As Range, rLogCells As Range

Set rLogCells = Intersect(Target, Union(Range("A1:A10"), Range("D110"), Range("H1:H10")))
If rLogCells Is Nothing Then Exit Sub

On Error GoTo EndNow
'Speed routines, 'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn
With Sheets("Log")
.Unprotect Password:="xyz"

For Each cell In rLogCells
tc = cell.Column
NR = .Cells(Rows.Count, tc).End(xlUp).Row + 1
Set rTC = .Cells(NR, tc)
rTC.Value = cell.Address(False, False)
rTC.Offset(0, 1).Value = Now
rTC.Offset(0, 2).Value = Environ("username")
'rTC.Offset(0, 3).Value = cell.Value
'rTC.Offset(0, 3).NumberFormat = cell.NumberFormat
Next cell

.UsedRange.EntireColumn.AutoFit
.Protect Password:="xyz"
End With
EndNow:
SpeedOff
End Sub[/VBA]

[Ger]

KH,

included an example of the file we work with. Sheet 2013 range I204 to oc284

must be logged.

Thx in advance.

Ger

[Zack Barresse]

Hi Ger,

No need to delete posts. It's just polite to let each of the boards know there's a cross-post out there. With most people giving of their free time to answer questions, they will be irritated if you're receiving help from others on things they're working with you on. Some solutions take quite a few hours to complete.

[Ger]

Oh if a password is asked its 123