Compile error: Member already exists in an object module from which this object module derives

A

an12drew

New Member
Joined
Dec 29, 2021
Messages
7
Office Version
  1. 365
Platform
  1. Windows
I am trying to lock cells A4:A500. When i protect my sheet, the VBA will not work so i tried to add the Sub unpotect and protect in but I keep getting this error. Any Ideas? Thank for the help.


VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim cell As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String

unprotect

Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
    Application.EnableEvents = False

'   Set drop-down values
    dd = Array("Test", "Test 2")

'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            msg = msg & cell.Address(0, 0) & ","
        End If
    Next cell

'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)

'   Reset validation
    With Range("H4:H500").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With

'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"

End If
End If
Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then

    Application.EnableEvents = False

'   Set drop-down values
    dd = Array("Test 3", "Test 4")

'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            msg = msg & cell.Address(0, 0) & ","
        End If
    Next cell

'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)

'   Reset validation
    With Range("G4:G500").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With

'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"

End If
End If

Set isect = Intersect(Range("B4:B500"), Target)
' Exit if updated cells do not fall in B4:B500
If Not isect Is Nothing Then
    Application.EnableEvents = False

'   Set drop-down values
    dd = Array("Division 1", "Division 2", "", "Division 3")

'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            msg = msg & cell.Address(0, 0) & ","
        End If
    Next cell

'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)

'   Reset validation
    With Range("B4:B500").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With

'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"

End If
End If
Application.EnableEvents = True

protect
End Sub


Sub unprotect()
ThisWorkbook.Sheets("Sheet3").unprotect "FPA"
ThisWorkbook.Sheets("Sheet2").unprotect "FPA"

End Sub

Sub protect()
ThisWorkbook.Sheets("Sheet3").protect "FPA"
ThisWorkbook.Sheets("Sheet2").protect "FPA"

End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Try changing the name of those two modules, you should never use VBA keywords (such as protect & unprotect) for the names of procedures or variables.
 
Upvote 0
A worksheet already has Unprotect and Protect methods so call the routines something else.
 
Upvote 0
Do NOT used reserved words like "protect" and "unprotect" for the names of your procedures!
That can cause errors and unexpected results, as VBA cannot determine if you are trying to call the inherent properties, objects, methods, or your procedures.
 
Upvote 0
Fluff said:
Try changing the name of those two modules, you should never use VBA keywords (such as protect & unprotect) for the names of procedures or variables.
Click to expand...

Okay, I changed the name and now I get a Subscript out of range

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim cell As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String

unpro

Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
    Application.EnableEvents = False

'   Set drop-down values
    dd = Array("Test", "Test 2")

'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            msg = msg & cell.Address(0, 0) & ","
        End If
    Next cell

'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)

'   Reset validation
    With Range("H4:H500").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With

'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"

End If
End If
Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then

    Application.EnableEvents = False

'   Set drop-down values
    dd = Array("Test 3", "Test 4")

'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            msg = msg & cell.Address(0, 0) & ","
        End If
    Next cell

'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)

'   Reset validation
    With Range("G4:G500").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With

'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"

End If
End If

Set isect = Intersect(Range("B4:B500"), Target)
' Exit if updated cells do not fall in B4:B500
If Not isect Is Nothing Then
    Application.EnableEvents = False

'   Set drop-down values
    dd = Array("Division 1", "Division 2", "", "Division 3")

'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            msg = msg & cell.Address(0, 0) & ","
        End If
    Next cell

'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)

'   Reset validation
    With Range("B4:B500").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With

'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"

End If
End If
Application.EnableEvents = True

pro
End Sub


Sub unpro()
ThisWorkbook.Sheets("Sheet3").unprotect "FPA"
ThisWorkbook.Sheets("Sheet2").unprotect "FPA"

End Sub

Sub pro()
ThisWorkbook.Sheets("Sheet3").protect "FPA"
ThisWorkbook.Sheets("Sheet2").protect "FPA"

End Sub
 
Upvote 0
Looking at that code, it would suggest that there isn't a Sheet3 or there isn't a Sheet2 (or both) in the workbook with the code.
 
Upvote 0
Solution
RoryA said:
Looking at that code, it would suggest that there isn't a Sheet3 or there isn't a Sheet2 (or both) in the workbook with the code.
Click to expand...
I forgot to rename the sheet. Thanks for the help.
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA_change array to Range
2
Replies
19
Views
1K
SP321
S
S
  • Solved
Combining multiple worksheet change events
Replies
1
Views
514
SP321
S
A
  • Question Question
2 Private Sub Worksheet_Change(ByVal Target As Range) ON SAME SHEET
Replies
7
Views
1K
Fluff
Fluff
T
  • Solved
I keep getting error message "member already exists in an object module from which this project module derives
Replies
4
Views
822
Skyybot
Skyybot
MartinS
  • Solved
Update Validation in Merged Cells
2
Replies
10
Views
537
Joe4
Joe4

Forum statistics

Threads
1,224,820
Messages
6,181,157
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top