Compile Error Private WithEvents oCbarEvents As CommandBars and Private Sub Worksheet

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

Attachment 30126

Code:

---

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:

Code:

---

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.

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.

Do you mean?

Code:

---

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?

Why do you introduce

Code:

---

Private WithEvents oCbarEvents As CommandBars

---

in a normal module ?
Who told you this ?

Quote:

---

Originally Posted by snb

Why do you introduce

Code:

---

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:

Code:

---

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

Code:

---

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:

Code:

---

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

---

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.

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:

Code:

---

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:

Code:

---

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:

Code:

---

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

---