ES16
10-17-2019, 07:26 AM
Hi,
I don't tend to use VBA very often. However I have one code that I use all the time. It has worked up until now for me until today, it isn't working on my current excel sheet. What the code does is lock cells once values have been entered, the only way to change them is to unprotect to worksheet. I've highlighted the line that VBA isn't happy with:
Dim mRg As Range
Dim mStr As String
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("C1,C3,G3,C6,C12,C18"), 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("C1,C3,G3,C6,C12,C18"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="teer"
If xRg.Value <> mStr Then xRg.Locked = True
Target.Worksheet.Protect Password:="teer"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("C1,C3,G3,C6,C12,C18"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
Sub sumit2()
'Unlocks cells "C1,C3,G3,C6,C12,C18,"
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
ActiveSheet.Unprotect Password:="teer"
mainworkBook.Sheets("sheet1").Range("C1,C3,G3,C6,C12,C18").Locked = False
Call FillCell
End Sub
Thanks
I don't tend to use VBA very often. However I have one code that I use all the time. It has worked up until now for me until today, it isn't working on my current excel sheet. What the code does is lock cells once values have been entered, the only way to change them is to unprotect to worksheet. I've highlighted the line that VBA isn't happy with:
Dim mRg As Range
Dim mStr As String
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("C1,C3,G3,C6,C12,C18"), 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("C1,C3,G3,C6,C12,C18"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="teer"
If xRg.Value <> mStr Then xRg.Locked = True
Target.Worksheet.Protect Password:="teer"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("C1,C3,G3,C6,C12,C18"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
Sub sumit2()
'Unlocks cells "C1,C3,G3,C6,C12,C18,"
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
ActiveSheet.Unprotect Password:="teer"
mainworkBook.Sheets("sheet1").Range("C1,C3,G3,C6,C12,C18").Locked = False
Call FillCell
End Sub
Thanks