VBA Error 'Range of object worksheet failed

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:

Code:

---

Dim mRg As Range
Dim mStr As String

---

Code:

---


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

---

Code:

---

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

---

Code:

---

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

---

Code:

---

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 know if it was a copy/paste error or a coding error, but I fixed the code in your post when I edited your post (to add Code Tags.) Does that change the way it works?

You are using the same code structure in several Event Subs. Does the problem happen in all subs?

I usually use Range.Cells(1)

Just for training, I rewrote you code page in my own style. I try to never use any code, other than one-line If...Thens in Event Subs

Code:

---

Option Explicit


Const PW As String = "teer"
Dim mRg As Range
Dim mStr As String
Dim Reference_Range As Range

 
Private Sub Worksheet_Activate()
  Set_ReferenceRange
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Set_referenceRange is needed in these 3 Event Subs for development purposes
'they should not be needed in Production. During Development, uncomment the lines in all 3 Subs
  'Set_ReferenceRange
  If CheckIntersect(Target) Then Set_mRg_mStr Target
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    'Set_ReferenceRange
    If CheckIntersect(Target) Then lockIntersection Target
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'Set_ReferenceRange
  If CheckIntersect(Target) Then Set_mRg_mStr Target
End Sub




Sub T()
'For testing
Dim X
X = mRg.Address
X = mStr
End Sub

Private Sub Set_ReferenceRange()
  Set Reference_Range = Me.Range("C1,C3,G3,C6,C12,C18")
End Sub

Private Function CheckIntersect(ByVal Target As Range) As Boolean
  If Not Intersect(Reference_Range, Target) Is Nothing Then CheckIntersect = True
End Function

Private Sub Set_mRg_mStr(ByVal Target As Range)
  Set mRg = Target.Cells(1)
  mStr = mRg.Value
End Sub

Private Sub ProtectThisSheet(YesNo As Boolean)
  If YesNo Then
      Me.Protect Password:=PW
  Else
      Me.Unprotect Password:=PW
  End If
End Sub

Private Sub lockIntersection(ByVal Target As Range)
  ProtectThisSheet False
      Intersect(Target, Reference_Range).Locked = True
  ProtectThisSheet True
End Sub


Sub SamT_Sumit2()
'Assumes this sub is on the same sheet as all the above
'Just an example
  ProtectThisSheet False
  Reference_Range.Locked = False
  FillCell
End Sub

Sub FillCell()
'Dummy sub for testing purposes
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

---

Neither option seems to work. It gets stuck at the same bit again. Why does copy and pasting from a previous worksheet not always work?

Quote:

---

Neither option seems to work

---

Which Options?

Quote:

---

Why does copy and pasting from a previous worksheet not always work?

---

What Copy Paste?

Hi ES16!
A simple attachment will be helpful.