Forcing input by user when cells are changed

olliestyles

New Member
Joined
Jun 22, 2011
Messages
4
Hi team,

I have posted this same query at http://www.excelforum.com/excel-pro...-user-when-cells-are-changed.html#post2548789 a few days ago, but unfortunately there have been no replies.

I am ultimately trying to achieve a track changes with commentary by the comment box and I have found two extremely useful posts but have had no joy in trying to bring the two lots of code together.

The first I found here http://excel.bigresource.com/Track/excel-tr0ODCpD/. This is the most useful as it tracks all changes in a cell from x to y and date and username stamps the entry and any subsequent changes are listed underneath, and it autosizes beautifully. However for my purpose I need to add a little bit of information to each entry. So I went in search of code that pops up a dialog box and what is input in the dialog box is recorded as the comment.

I found this useful post here http://www.excelforum.com/excel-prog...e-comment.html. The only thing is getting it to work for all cells that aren't protected, and combining it with the above code so that a resulting comment would look something like:

Changed from "x" to "y" on 21/06/11 at 7:17pm by olliestyles (from first code)
Reason: Agreed new value with stylieo by email on 20/06/11 (this text input by the textbox that pops up from the 2nd code).

So, if there were two changes to the same cell the comment box would read:

Changed from "x" to "y" on 21/06/11 at 7:17pm by olliestyles
Reason: Agreed new value with stylieo by email on 20/06/11

Changed from "y" to "x" on 22/06/11 at 7:17pm by olliestyles
Reason: Stylieo changed his mind and reverted to x value by phone on 22/06/11

Thanks heaps for your time.

Ollie
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
This appears to work as you require:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim NewText As String
    Dim OldText As String
    Dim OldValue As String
    Dim NewValue As String
    Dim sReason As String
 
    If Not Target.Locked Then
 
        NewValue = Target.Value
        Application.EnableEvents = False
        Application.Undo
        OldValue = Target.Value
 
        sReason = InputBox("Enter reason for change", "Enter Reason", Application.UserName & " says so!")
        If sReason = "" Then sReason = Application.UserName & "says so!"
 
        NewText = "Changed from " & Chr(34) & OldValue & Chr(34) & " to " & Chr(34) & NewValue & Chr(34) _
            & " on " & Format(Date, "dd/mm/yyyy") _
            & " at " & Format(Time, "h:mmam/pm") _
            & " by " & Application.UserName & vbLf & _
            "Reason: " & sReason & vbLf
        If Target.Comment Is Nothing Then
            Target.AddComment
        End If
 
        With Target.Comment
            .Shape.TextFrame.AutoSize = True
            OldText = .Text & vbLf
            .Text Text:=OldText & NewText
        End With
        Target.Value = NewValue
        Application.EnableEvents = True
 
    End If
End Sub
 
Upvote 0
This appears to work as you require:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim NewText As String
    Dim OldText As String
    Dim OldValue As String
    Dim NewValue As String
    Dim sReason As String
 
    If Not Target.Locked Then
 
        NewValue = Target.Value
        Application.EnableEvents = False
        Application.Undo
        OldValue = Target.Value
 
        sReason = InputBox("Enter reason for change", "Enter Reason", Application.UserName & " says so!")
        If sReason = "" Then sReason = Application.UserName & "says so!"
 
        NewText = "Changed from " & Chr(34) & OldValue & Chr(34) & " to " & Chr(34) & NewValue & Chr(34) _
            & " on " & Format(Date, "dd/mm/yyyy") _
            & " at " & Format(Time, "h:mmam/pm") _
            & " by " & Application.UserName & vbLf & _
            "Reason: " & sReason & vbLf
        If Target.Comment Is Nothing Then
            Target.AddComment
        End If
 
        With Target.Comment
            .Shape.TextFrame.AutoSize = True
            OldText = .Text & vbLf
            .Text Text:=OldText & NewText
        End With
        Target.Value = NewValue
        Application.EnableEvents = True
 
    End If
End Sub

Hi Phil,

Thanks for your reply. I haven't been able to get this to work. Whenever i make changes nothing happens at all. Could it be missing something? Or have I done something wrong. Thanks again,

Ollie
 
Upvote 0
Phil,

After playing around some more I got code very similar to yours working. Not sure why I couldn't get yours to run?? Anyway thanks very much for your help. Here is what I have got to work, if you have any suggestions for improvement please let me know.


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
  Dim NewText As String
  Dim OldText As String
  Dim OldValue As String
  Dim NewValue As String
  Dim Str As String
  
  NewValue = Target.Value
  Application.EnableEvents = False
  Application.Undo
  OldValue = Target.Value
  Str = InputBox("Reason for change")
  If Str = "" Then Str = "No reason given, change invalid"
  
        NewText = "- Updated on " & Format(Date, "dd-mm-yyyy ") _
            & " at " & Format(Time, "hh:mm") _
            & " - " & " Changed from " & OldValue & " to " & NewValue _
            & " by " & Application.UserName & " because " & Str & vbLf

            
    If Target.Comment Is Nothing Then
       Target.AddComment
    End If
    
    With Target.Comment
      .Shape.TextFrame.AutoSize = True
      OldText = .Text & vbLf
      .Text Text:=OldText & NewText
    End With
  Target.Value = NewValue
  Application.EnableEvents = True
End Sub
Thanks again,
Ollie
 
Upvote 0
My code would only work when the target cell are not locked (you had said "The only thing is getting it to work for all cells that aren't protected"so I assumed that was one of the requirements in the desired code. (Format | Cells | Protection and uncheck Locked checkbox). Since cells are all locked by default, my code would not do anything to the locked cells.

Remove the If Not Target.Locked and the associated End If statements to get my code working whether the cells are locked or not.

Yours looks good. Glad to help.
 
Upvote 0
My code would only work when the target cell are not locked (you had said "The only thing is getting it to work for all cells that aren't protected"so I assumed that was one of the requirements in the desired code. (Format | Cells | Protection and uncheck Locked checkbox). Since cells are all locked by default, my code would not do anything to the locked cells.

Remove the If Not Target.Locked and the associated End If statements to get my code working whether the cells are locked or not.

Yours looks good. Glad to help.

Excellent, thanks again for your help Phil. Yes I did intend to protect cells so that only the desired ones got changed but I ended up not protecting any while I was trying out the code. As a complete noob to VBA code I didn't realise that would not let it work. But, I have learned something new today, thanks again!!
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top