I created a sub procedure that highlight changes made by a use on the sheet. However you can't undo (CRTL+ Z). How can i add an undo and i don't want to prompt the user for anything. Just undo the highlight and the info entered.
There are the codes. They do two things: the first is for a data validator, the second is for the highlight changes
Option Explicit
Public Sub Worksheet_Change(ByVal Target As Range)
' To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 3 And Target.Row > 4 And Target.Row < 100 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
'--------------------------------------------------------------------------------------------------------------------------------------------
'Public Sub Worksheet_Change_2(ByVal Target As Range)
Dim ws As Worksheet, ws2 As Worksheet
Dim i As Boolean
Application.ScreenUpdating = False
'Create Change Log if one does not exist.
If Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 12 And Target.Row > 6 And Target.Row < 81 Then
i = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Change Log" Then
i = True
Exit For
End If
Next ws
If Not i Then
Set ws2 = ThisWorkbook.Worksheets.Add
ws2.Visible = xlSheetHidden
ws2.Name = "Change Log"
ws2.Range("A2") = "Sheet"
ws2.Range("B2") = "Range"
ws2.Range("C2") = "Old Text Color"
Else
Set ws2 = Sheets("Change Log")
End If
'Store previous color data in change log for rollback.
ws2.Range("A1").Offset(ws2.UsedRange.Rows.Count, 0) = Target.Worksheet.Name
ws2.Range("B1").Offset(ws2.UsedRange.Rows.Count - 1, 0) = Target.Address
ws2.Range("C1").Offset(ws2.UsedRange.Rows.Count - 1, 0) = Target.Font.Color
'Change font color to red.
Target.Font.Color = 255
Target.Interior.ColorIndex = 27
'Range("A1").Interior.ColorIndex = 37
Application.ScreenUpdating = True
End If
End Sub
I found this rollback procedure but i am not able to make it work
Sub rollbackHILITE()
Dim sht As Worksheet, cl As Worksheet
Dim j As Long, roll() As Variant
Dim del As Integer
Application.ScreenUpdating = False
'Find Change Log. If it doesn't exist, user is prompted and exits sub.
For Each sht In ThisWorkbook.Worksheets
If sht.Name = "Change Log" Then
Set cl = sht
Exit For
End If
Next sht
If cl Is Nothing Then
MsgBox "Change Log not found!"
Exit Sub
End If
'Return font colors to original form by stepping backward through change log.
If cl.UsedRange.Rows.Count > 1 Then
roll = cl.Range("I4:L4").Resize(cl.UsedRange.Rows.Count - 1, 3)
For j = UBound(roll, 1) To 1 Step -1
Set sht = Sheets(roll(j, 1))
sht.Range(roll(j, 2)).Font.Color = roll(j, 3)
Next j
End If
Application.ScreenUpdating = True
'Prompt User to keep or delete change log after rollback.
del = MsgBox("Delete Change Log?", vbOKCancel, "Finish Rollback")
If del = 1 Then
cl.Delete
End If
End Sub
Bookmarks