Ændring af celler i Excel

Med denne makro kan du sætte en note ind om hvad der er ændret, hvem der har gjort det og hvornår

Private Sub Worksheet_Change(ByVal Target As Range)
Dim User As String, stOldText As String
'**********************************************************************
'Disse 3 linier kan slettes hvis man ønsker at kommenteringen skal
'ske på alle celler i arket.
'Ellers skal man ændre linien Set rng = range("A1:K100") til det
'område man ønsker at kommentering skal ske i.
Dim Rng As Range
Set Rng = Range("A1:K100")
If Intersect(Target, Rng) Is Nothing Then Exit Sub
'**********************************************************************
        User = Target.Value & " : " & (Environ("Username") & "  :  " & Now())
        On Error Resume Next
        If IsError(stOldText = Target.Comment.Text) = True Then
            Target.AddComment User
        Else
            stOldText = Target.Comment.Text
            Target.Comment.Text Text:=stOldText & vbLf & User
        End If
        Target.Comment.Shape.TextFrame.AutoSize = True
End Sub

Hvis du ikke ønsker, at det skal stå i selve cellen, kan du forskyde noten til en skjult kolonne. Eksemplet herunder forskyder det 26 kolonner, så noten for kolonne A kommer i kolonne AA

Private Sub Worksheet_Change(ByVal Target As Range)
Dim User As String, stOldText As String
'**********************************************************************
'Disse 3 linier kan slettes hvis man ønsker at kommenteringen skal
'ske på alle celler i arket.
'Ellers skal man ændre linien Set rng = range("A1:K100") til det
'område man ønsker at kommentering skal ske i.
Dim Rng As Range
Set Rng = Range("A1:K100")
If Intersect(Target, Rng) Is Nothing Then Exit Sub
'**********************************************************************
        User = Target.Value & " : " & (Environ("Username") & "  :  " & Now())
        On Error Resume Next
        If IsError(stOldText = Target.Comment.Text) = True Then
            Target.Offset(0, 26).AddComment User
        Else
            stOldText = Target.Comment.Text
            Target.Offset(0, 26).Comment.Text Text:=stOldText & vbLf & User
        End If
        Target.Offset(0, 26).Comment.Shape.TextFrame.AutoSize = True
End Sub

Der var fejl i den sidste del (makroen med forskydning af noterne). Den burde se sådan ud:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim User As String, stOldText As String
Dim Rng As Range
Set Rng = Range("A1:K100")
If Intersect(Target, Rng) Is Nothing Then Exit Sub
        User = Target.Value & " : " & (Environ("Username") & "  :  " & Now())
        On Error Resume Next
        If IsError(stOldText = Target.Offset(0, 26).Comment.Text) = True Then
            Target.Offset(0, 26).AddComment User
        Else
            stOldText = Target.Offset(0, 26).Comment.Text
            Target.Offset(0, 26).Comment.Text Text:=stOldText & vbLf & User
        End If
        Target.Offset(0, 26).Comment.Shape.TextFrame.AutoSize = True
End Sub