I have an invoice set up with validation list on a separate worksheet listing all our parts we sell. I put combo boxes on the invoice and linked them to the validation list and included code so that when box is double clicked, it will start auto completing the box using the validation list when typed. I also included code so that when this invoice is closed at end of the day, and then reopened the next day, or when shortcut key is pressed, it will clear the contents and change the invoice number.
Sometimes I need to save a, invoice to add on or change later. So I copy that worksheet and rename it with customer name. This has worked fine for over a year. But last week, when I click on any cell on the copied worksheets, it has a runtime error 1004 Method "OLEObjects" of object"_Worksheet" failed. Then the combo boxes don't work. But it only does it on the copied worksheets. The original worksheet works fine. Any suggestions? Here is the code used:
'==========================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("ValidationLists")
Cancel = True
Set cboTemp = ws.OLEObjects("Parts")
On Error Resume Nex
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = True
If Application.CutCopyMode Then
'allow copying and pasting on the worksheet
GoTo errHandler
End If
Set cboTemp = ws.OLEObjects("Parts")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
Private Sub Parts_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
Set cboTemp = ws.OLEObjects("Parts") is where the problem is. It appears twice and gets flagged on both of them.
