Compile Error Private WithEvents oCbarEvents As CommandBars and Private Sub Worksheet

[MSXL]

I am getting the following error when working on a different workbook, whilst this one is open:

30126


Private WithEvents oCbarEvents As CommandBars

It appears to be something to do with any worksheet containing "Private Sub Worksheet_Change(ByVal Target As Range)" as that's when the error occurs, when switching between sheets in another open workbook.


For example:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C4"), Target) Is Nothing Then
If Range("C4").Value = "" Then
Application.EnableEvents = False
Range("C4").Value = "'Choose"
Application.EnableEvents = True
End If
End If
End Sub




Does anyone know how this can be resolved?

Thanks.

[Aussiebear]

Sorry but I'm a little old school, and I understand that you new age guys like to shorten your code significantly but....

If you have an "If... then" and you offer an alternative should it not read " If ... then", 'Else", "End If". To me its untidy coding.

[MSXL]

Do you mean?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C4"), Target) Is Nothing Then
If Range("C4").Value = "" Then
Application.EnableEvents = False
Else
Range("C4").Value = "'Choose"
Application.EnableEvents = True
End If
End If
End Sub

Is that causing the error?

[snb]

Why do you introduce

Private WithEvents oCbarEvents As CommandBars
in a normal module ?
Who told you this ?

[MSXL]

Why do you introduce

Private WithEvents oCbarEvents As CommandBars
in a normal module ?
Who told you this ?

arnelgp in the other thread.

To confirm, this is the complete code so you can see:

ThisWorkbook:


Option Explicit


Private WithEvents oCbarEvents As CommandBars


#If VBA7 Then
Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "User32" () As Long
#Else
Private Declare Function GetClipboardSequenceNumber Lib "User32" () As Long
#End If


Private Const TARGET_SHEET As String = "Clipboard"
Private Const TARGET_RANGE As String = "C7,C8,C9,C10,C11,C13,E7,E10,E13,G13,I13,E16,G16,I16,C16,C19,E19,C22" 'Set tab order
Private Const TARGET_INFO_RANGE As String = "C4"


Private Sub Workbook_Open()
' Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,I13,E16,G16,I16,E19:I19").ClearContents
Call ClipOff
'arnelgp
'intialize the array
Sheets("Clipboard").Range("A1").Select
Clipboard.strAddress = "$C$7"
Sheets("Clipboard").Select
Range(Clipboard.strAddress).Select

With Sheet10
.Unprotect
.Shapes("Status").TextFrame.Characters.Text = "Input Mode"
.Protect
End With

Application.EnableEvents = True
Application.OnKey "{TAB}", "Clipboard.ProcessTab"
Application.OnKey "+{TAB}", "Clipboard.ProcessBkTab"
'Cells included in array
Clipboard.arr = Array("$C$7", "$C$8", "$C$9", "$C$10", "$C$11", "$C$13", "$E$7", "$E$10", "$E$13", "$G$13", "$I$13", "$E$16", "$G$16", "$I$16", "$C$16", "$C$19", "$E$19", "$C$22")

Set oCbarEvents = Application.CommandBars
Application.EnableEvents = False
Dim Sh As Worksheet
For Each Sh In Worksheets
If Sh.Name = "Property Numbering" Then
Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
Sh.Range("C14,C8").ClearContents
Sh.Range("B2").Value = "'Property Reference Guide (Click Arrow to Start)"
Sh.Range("C14,C8").Value = "'Choose"
ElseIf Sh.Name = "VO Areas" Then
Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
Sh.Range("C4").ClearContents
Sh.Range("C4").Value = "'Choose"
Else
Sh.Protect UserInterFaceOnly:=True
End If
Next
Application.EnableEvents = True
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Set oCbarEvents = Application.CommandBars
End Sub


Private Sub oCbarEvents_OnUpdate()


Static lPrevSN As Long

Dim MyDataObject As Object
Dim lCutCopy As Long
Dim sClipText As String

If GetClipboardSequenceNumber <> lPrevSN Then
If Application.CutCopyMode <> False Then
With Sheets(TARGET_SHEET)
lCutCopy = Application.CutCopyMode
If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MyDataObject.GetFromClipboard
sClipText = MyDataObject.GetText(1)
Mid(sClipText, Len(sClipText), 1) = vbNullChar
If InStr(sClipText, Chr(&HA)) Then
sClipText = Replace(sClipText, Chr(&H22), "")
End If
If .ProtectContents Then
.Unprotect
.Range(TARGET_INFO_RANGE) = sClipText
.Protect
End If
Set oCbarEvents = Nothing
If lCutCopy = 1 Then
ActiveWindow.RangeSelection.Copy
Else
ActiveWindow.RangeSelection.Cut
End If
Set oCbarEvents = Application.CommandBars
End If
End With
End If
End If
lPrevSN = GetClipboardSequenceNumber
End Sub





Worksheet: Clipboard

Option Explicit


Public IsClipRunning As Boolean


Private Sub Worksheet_Activate()
With Worksheets("Clipboard")
.Range("C7").Select
strAddress = .ActiveCell.Address
' MsgBox "Software relies heavily on the Windows clipboard." & Chr(13) & Chr(13) & "If you need to duplicate information to multiple accounts/properties, use this tool." & Chr(13) & Chr(13) & "Type the information needed, press ""Enter"" and then any cell you click on will automatically be copied to the clipboard.", vbInformation + vbOKOnly, "Automatic Clipboard"
End With
With ActiveWindow
.DisplayFormulas = False
.DisplayHeadings = False
.DisplayGridlines = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = True
End With
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
.DisplayStatusBar = False
.CommandBars("Full Screen").Visible = True
.CommandBars("Worksheet Menu Bar").Enabled = False
.CommandBars("Standard").Visible = False
.CommandBars("Formatting").Visible = False
End With
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


Dim thisAddress As String
thisAddress = Split(Target.Address, ":")(0)
Clipboard.strAddress = Target.Address
If IsClipRunning Then
If Len(Trim$(Sheet10.Range(thisAddress).Value & "")) Then
putToClipboard Sheet10.Range(thisAddress).Value
End If
End If
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox ("To paste data, press ""Ctrl"" & ""V""."), _
vbInformation, "Automatic Clipboard"
End Sub


Sub PasteasValue()
Selection.PasteSpecial Paste:=xlPasteValues
End Sub



Clipboard Module:


Option Explicit


Public arr As Variant
Public strAddress As String


Public Sub ProcessTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
For i = 0 To UBound(arr)
If arr(i) = Split(strAddress, ":")(0) Then
If i = UBound(arr) Then
i = 0
Else
i = i + 1
End If
Exit For
End If
Next
ActiveSheet.Range(arr(i)).Select
Else
strAddress = arr(0)
End If
End Sub


Public Sub ProcessBkTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
For i = 0 To UBound(arr)
If arr(i) = Split(strAddress, ":")(0) Then
If i = 0 Then
i = UBound(arr)
Else
i = i - 1
End If
Exit For
End If
Next
ActiveSheet.Range(arr(i)).Select
Else
strAddress = arr(0)
End If
End Sub


Public Function putToClipboard(ByVal theValue As Variant)
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText theValue & ""
.PutInClipboard
End With
Sheet10.Range("$C$4") = theValue
End Function


Public Sub ClipOn()
Dim thisAddress As String
thisAddress = Split(strAddress, ":")(0)
With Sheet10
.IsClipRunning = True
' unprotect and change the color of the "play" button to red (or you may use any color)
.Unprotect
.Shapes("Status").TextFrame.Characters.Text = "Copy Mode"
.Shapes("Status").TextFrame.Characters.Font.Color = vbWhite
.Shapes("Status").Fill.ForeColor.RGB = vbRed
.Shapes("Button 33").TextFrame.Characters.Font.Color = vbRed
.Shapes("Button 34").TextFrame.Characters.Font.Color = vbBlack
Sheet10.Range("C7,C8,C9,C10,C11,C13,C16,C19,C22,E7:I7,E10:I10,E13,I13,E16,E19:I19,G13,G16, I16").Interior.Color = RGB(242, 242, 242)
Sheet10.Range("C6:C11,C12:C13,C15:C16,C18:C19,E6:I7,E9:I10,E12:E13,E15:E16,G12:G13,G15:G16 ,I12:I13,I15:I16,E18:I19,C21:I22").Font.Color = RGB(128, 134, 146)
.Protect
If Len(Trim$(.Range(thisAddress).Value & "")) Then
Call putToClipboard(.Range(thisAddress).Value)
End If
End With
End Sub


Public Sub ClipOff()
With Sheet10
' unprotect to re-instate the color of "play" button to black
.Unprotect
.Shapes("Status").TextFrame.Characters.Text = "Input Mode"
.Shapes("Status").TextFrame.Characters.Font.Color = vbBlack
.Shapes("Status").Fill.ForeColor.RGB = RGB(146, 208, 80)
.Shapes("Button 33").TextFrame.Characters.Font.Color = vbBlack
.Shapes("Button 34").TextFrame.Characters.Font.Color = RGB(146, 208, 80)
.IsClipRunning = False
.Protect
End With
End Sub


Public Sub ClipClear()
Dim Answer As Integer
Answer = MsgBox("Are you sure you wish to clear the data?", vbQuestion + vbYesNo + vbDefaultButton2, "Automatic Clipboard")
If Answer = vbYes Then
Call ClipOff
Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,I13,E16,G16,I16,E19:I19").ClearContents
Sheet10.Range("C7:C11,C13,C16,C19,C22,E7:I7,E10:I10,E13,I13,E16,E19:I19,G13,G16,I16").Interior.Color = RGB(146, 208, 80)
Sheet10.Range("C6:C11,C12:C13,C15:C16,C18:C19,E6:I7,E9:I10,E12:E13,E15:E16,G12:G13,G15:G16 ,I12:I13,I15:I16,E18:I19,C21:I22").Font.Color = vbBlack
Weight:=xlMedium, Color:=vbBlack
Sheet10.Range("A1").Select
Sheet10.Range("C7").Select
Sheet10.Range("$C$4") = Null
Else
'Do nothing
End If
End Sub


Sub Help_Click()
Dim Help As Integer
Help = MsgBox("Software relies heavily on the Windows clipboard." & Chr(13) & Chr(13) & _
"If you need to duplicate information to multiple accounts/properties, use this tool." & Chr(13) & Chr(13) & _
"Type the information you need to copy, then within ""Clipboard Controls"" click """ & Chr(62) & """ and then any cell you click on will automatically be copied to the clipboard." & Chr(13) & Chr(13) & _
"To input text, click ""||"" and when finished, click """ & Chr(62) & """ to continue copying.", _
vbOKOnly + vbInformation, "About Automatic Clipboard")
If Help = vbOK Then
End If
End Sub

[arnelgp]

i am sorry MXSL, the code with Commandbar is already there when you uploaded your workbook.
i did not bother to check it since it is not related to Clipboard thing and i made my own Module (Module1).
and just complemented some events that will fill my strAddress variable.

what i will suggest is make a backup of the original workbook and check if Deleting this
code will not affect any previous operations you have.

[MSXL]

Thank you for your reply and apologies for getting confused. Removing that code doesn't seem to have caused any issues that I have noticed so far.


ThisWorkbook:

Option Explicit


#If VBA7 Then
Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "User32" () As Long
#Else
Private Declare Function GetClipboardSequenceNumber Lib "User32" () As Long
#End If


Private Const TARGET_SHEET As String = "Clipboard"
Private Const TARGET_RANGE As String = "C7,C8,C9,C10,C11,C13,E7,E10,E13,G13,I13,E16,G16,I16,C16,C19,E19,C22" 'Set tab order
Private Const TARGET_INFO_RANGE As String = "C4"


Private Sub Workbook_Open()
' Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,I13,E16,G16,I16,E19:I19").ClearContents
Call ClipOff
'arnelgp
'intialize the array
Sheets("Clipboard").Range("A1").Select
Clipboard.strAddress = "$C$7"
Sheets("Clipboard").Select
Range(Clipboard.strAddress).Select

With Sheet10
.Unprotect
.Shapes("Status").TextFrame.Characters.Text = "Input Mode"
.Protect
End With

Application.EnableEvents = True
Application.OnKey "{TAB}", "Clipboard.ProcessTab"
Application.OnKey "+{TAB}", "Clipboard.ProcessBkTab"
'Cells included in array
Clipboard.arr = Array("$C$7", "$C$8", "$C$9", "$C$10", "$C$11", "$C$13", "$E$7", "$E$10", "$E$13", "$G$13", "$I$13", "$E$16", "$G$16", "$I$16", "$C$16", "$C$19", "$E$19", "$C$22")

' Set oCbarEvents = Application.CommandBars
Application.EnableEvents = False
Dim Sh As Worksheet
For Each Sh In Worksheets
If Sh.Name = "Property Numbering" Then
Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
Sh.Range("C14,C8").ClearContents
Sh.Range("B2").Value = "'Property Reference Guide (Click Arrow to Start)"
Sh.Range("C14,C8").Value = "'Choose"
ElseIf Sh.Name = "VO Areas" Then
Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
Sh.Range("C4").ClearContents
Sh.Range("C4").Value = "'Choose"
Else
Sh.Protect UserInterFaceOnly:=True
End If
Next
Application.EnableEvents = True
End Sub



Clipboard:

Option Explicit


Public IsClipRunning As Boolean


Private Sub Worksheet_Activate()
With Worksheets("Clipboard")
.Range("C7").Select
strAddress = .ActiveCell.Address
End With
With ActiveWindow
.DisplayFormulas = False
.DisplayHeadings = False
.DisplayGridlines = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = True
End With
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
.DisplayStatusBar = False
.CommandBars("Full Screen").Visible = True
.CommandBars("Worksheet Menu Bar").Enabled = False
.CommandBars("Standard").Visible = False
.CommandBars("Formatting").Visible = False
End With
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim thisAddress As String
thisAddress = Split(Target.Address, ":")(0)
Clipboard.strAddress = Target.Address
If IsClipRunning Then
If Len(Trim$(Sheet10.Range(thisAddress).Value & "")) Then
putToClipboard Sheet10.Range(thisAddress).Value
End If
End If
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox ("To paste data, press ""Ctrl"" & ""V""."), _
vbInformation, "Automatic Clipboard"
End Sub


Sub PasteasValue()
Selection.PasteSpecial Paste:=xlPasteValues
End Sub



Clipboard Module:

Option Explicit


Public arr As Variant
Public strAddress As String


Public Sub ProcessTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
For i = 0 To UBound(arr)
If arr(i) = Split(strAddress, ":")(0) Then
If i = UBound(arr) Then
i = 0
Else
i = i + 1
End If
Exit For
End If
Next
ActiveSheet.Range(arr(i)).Select
Else
strAddress = arr(0)
End If
End Sub




Public Sub ProcessBkTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
For i = 0 To UBound(arr)
If arr(i) = Split(strAddress, ":")(0) Then
If i = 0 Then
i = UBound(arr)
Else
i = i - 1
End If
Exit For
End If
Next
ActiveSheet.Range(arr(i)).Select
Else
strAddress = arr(0)
End If
End Sub


Public Function putToClipboard(ByVal theValue As Variant)
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText theValue & ""
.PutInClipboard
End With
Sheet10.Range("$C$4") = theValue
End Function


Public Sub ClipOn()
Dim thisAddress As String
thisAddress = Split(strAddress, ":")(0)
With Sheet10
.IsClipRunning = True
' unprotect and change the color of the "play" button to red (or you may use any color)
.Unprotect
.Shapes("Status").TextFrame.Characters.Text = "Copy Mode"
.Shapes("Status").TextFrame.Characters.Font.Color = vbWhite
.Shapes("Status").Fill.ForeColor.RGB = vbRed
.Shapes("Button 33").TextFrame.Characters.Font.Color = vbRed
.Shapes("Button 34").TextFrame.Characters.Font.Color = vbBlack
Sheet10.Range("C7,C8,C9,C10,C11,C13,C16,C19,C22,E7:I7,E10:I10,E13,I13,E16,E19:I19,G13,G16, I16").Interior.Color = RGB(242, 242, 242)
Sheet10.Range("C6:C11,C12:C13,C15:C16,C18:C19,E6:I7,E9:I10,E12:E13,E15:E16,G12:G13,G15:G16 ,I12:I13,I15:I16,E18:I19,C21:I22").Font.Color = RGB(128, 134, 146)
.Protect
If Len(Trim$(.Range(thisAddress).Value & "")) Then
Call putToClipboard(.Range(thisAddress).Value)
End If
End With
End Sub


Public Sub ClipOff()
With Sheet10
' unprotect to re-instate the color of "play" button to black
.Unprotect
.Shapes("Status").TextFrame.Characters.Text = "Input Mode"
.Shapes("Status").TextFrame.Characters.Font.Color = vbBlack
.Shapes("Status").Fill.ForeColor.RGB = RGB(146, 208, 80)
.Shapes("Button 33").TextFrame.Characters.Font.Color = vbBlack
.Shapes("Button 34").TextFrame.Characters.Font.Color = RGB(146, 208, 80)
Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,G13,I13,E16,G16,I16,E19:I19").Interior.Color = RGB(146, 208, 80)
Sheet10.Range("C6:C11,C12:C13,C15:C16,C18:C19,E6:I7,E9:I10,E12:E13,E15:E16,G12:G13,G15:G16 ,I12:I13,I15:I16,E18:I19,C21:I22").Font.Color = vbBlack
.IsClipRunning = False
.Protect
End With
End Sub


Public Sub ClipClear()
Dim Answer As Integer
Answer = MsgBox("Are you sure you wish to clear the data?", vbQuestion + vbYesNo + vbDefaultButton2, "Automatic Clipboard")
If Answer = vbYes Then
Call ClipOff
' MsgBox "Cleared"
Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,I13,E16,G16,I16,E19:I19").ClearContents
Sheet10.Range("C7:C11,C13,C16,C19,C22,E7:I7,E10:I10,E13,I13,E16,E19:I19,G13,G16,I16").Interior.Color = RGB(146, 208, 80)
Sheet10.Range("C6:C11,C12:C13,C15:C16,C18:C19,E6:I7,E9:I10,E12:E13,E15:E16,G12:G13,G15:G16 ,I12:I13,I15:I16,E18:I19,C21:I22").Font.Color = vbBlack
Sheet10.Range("A1").Select
Sheet10.Range("C7").Select
Sheet10.Range("$C$4") = Null
Else
'Do nothing
End If
End Sub


Sub Help_Click()
Dim Help As Integer
Help = MsgBox("Software relies heavily on the Windows clipboard." & Chr(13) & Chr(13) & _
"If you need to duplicate information to multiple accounts/properties, use this tool." & Chr(13) & Chr(13) & _
"Type the information you need to copy, then within ""Clipboard Controls"" click """ & Chr(62) & """ and then any cell you click on will automatically be copied to the clipboard." & Chr(13) & Chr(13) & _
"To input text, click ""||"" and when finished, click """ & Chr(62) & """ to continue copying.", _
vbOKOnly + vbInformation, "About Automatic Clipboard")
If Help = vbOK Then
End If
End Sub