VBA to lock Cell after Data Entry but still Allow Sort & Filter ?

[Dazzybeeguy]

I have tried using this VBA below to lock cells after an entry in a cell, it works fine but it disables sort & filter, is there any way around this ??

Thanks

Dim mRg As Range
Dim mStr As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("f3:F1100"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("f3:F1100"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="Password"
If xRg.Value <> mStr Then xRg.Locked = True
Target.Worksheet.Protect Password:="Password"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("f3:F1100"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub

 

[Jeffrey Mahoney]

This is the way I would do it. Using the UserInterFaceOnly parameter allows the macro to do anything to the sheet without having to unlock it. Making the sheet locked when sombody activates the sheet locks it all the time. The other parameters I added to the Protect command allows users to sort and autofilter.

Private Sub Worksheet_Activate()
  Sht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowSorting:=True, AllowFiltering:=True, UserInterfaceOnly:=True
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
  Dim xRg As Range
  Dim Sht As Worksheet
  On Error Resume Next
  Set xRg = Intersect(Range("f3:F1100"), Target)
  If xRg Is Nothing Then Exit Sub
  Set Sht = ActiveSheet
  Sht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowSorting:=True, AllowFiltering:=True, UserInterfaceOnly:=True
  
  If xRg.Value <> mStr Then xRg.Locked = True
  
End Sub

 

[Dazzybeeguy]

This is the way I would do it. Using the UserInterFaceOnly parameter allows the macro to do anything to the sheet without having to unlock it. Making the sheet locked when sombody activates the sheet locks it all the time. The other parameters I added to the Protect command allows users to sort and autofilter.

Private Sub Worksheet_Activate()
  Sht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowSorting:=True, AllowFiltering:=True, UserInterfaceOnly:=True
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
  Dim xRg As Range
  Dim Sht As Worksheet
  On Error Resume Next
  Set xRg = Intersect(Range("f3:F1100"), Target)
  If xRg Is Nothing Then Exit Sub
  Set Sht = ActiveSheet
  Sht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowSorting:=True, AllowFiltering:=True, UserInterfaceOnly:=True
 
  If xRg.Value <> mStr Then xRg.Locked = True
 
End Sub

When I used that it didn't lock the cell after data entry, I want it so users cant accidentally or on purpose change a cell that already populated, but I still want to allow them to Sort & Filter

 

[Jeffrey Mahoney]

All I did was add the code to lock the sheet differently. You have code that tests if the altered cell falls within Range F3:F1100 and
If xRg.Value <> mStr Then xRg.Locked = True

You should step through the code one line at a time to see which line is preventing the result you wanted.