Combine 2 macros together - can someone help combine these together
THIS DOES NOT ALLOW DELETE
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CountAfter As Long
If Target.Count > 1 Then
CountAfter = Application.CountA(Target)
Application.EnableEvents = False
If CountAfter = 0 Then
Application.Undo
MsgBox "Clearing of cells is not permitted.", 16, "ERROR"
End If
Application.EnableEvents = True
Exit Sub
End If
If IsEmpty(Target.Value) Then
Application.EnableEvents = False
Application.Undo
MsgBox "text cannot be deleted.", 16, "ERROR"
Application.EnableEvents = True
End If
End Sub
............................................................................
THIS JUST PUTS THE TEXT BACK BUT ALLOWS DELETE
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sel, sv
Dim rng As Range, cell As Range, plan As Range
Dim rng2 As Range, cell2 As Range, WO As Range
Set sel = Selection
sv = sel.Value
Application.EnableEvents = False
On Error GoTo e
Application.Undo
Set rng = Range([A1], [IV1].End(xlToLeft))
For Each cell In rng
If cell = "Plan" Then
If plan Is Nothing Then
Set plan = Intersect(cell.EntireColumn, ActiveSheet.UsedRange)
Else
Set plan = Union(plan, Intersect(cell.EntireColumn, ActiveSheet.UsedRange))
End If
End If
Next
If Not plan Is Nothing Then
Set rng2 = Application.Intersect(Target, plan)
If Not rng2 Is Nothing Then
For Each cell2 In rng2
If cell2 = "WO" Then
MsgBox "You cannot change " & cell2.Address(False, False)
GoTo e
End If
Next
End If
End If
sel.Value = sv
e:
Application.EnableEvents = True
End Sub
Bookmarks