Combobox Code, Wont Copy and paste?

M

MelissaDeMille

I have a question regarding the below code. This works great except for one
problem, once I have this code, it ruins
another macro I have set up. The other macro is designed to copy a set of
rows and paste them in. Essentially adding a job to our Manpower tracking.
After the above code is placed in the worksheet, it disables the ability to
copy and past. Any suggestions? Thanks in advance.


Private Sub EmpName_Change()

End Sub

Private Sub ComboBox1_Change()

End Sub

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("2007 Manpower")

Cancel = True
Set cboTemp = ws.OLEObjects("EmpName")
On Error Resume Next
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_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

Set cboTemp = ws.OLEObjects("EmpName")
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 TempCombo_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
'====================================
 
T

Tom Ogilvy

It is your selectionchange macro. When it runs, it clears the clipboard.

Microsoft had the same problem when they release their Y2K addin several
years ago.


you can try

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
' added line
if application.CutCopyMode <> False then exit sub
Set ws = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = True

Set cboTemp = ws.OLEObjects("EmpName")
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 '====================================

I don't know if that will cure it, but its worth a shot.
 
M

MelissaDeMille

Thank you, that worked! I may be on with more questions, I am really new at
this and have a project to complete here at work. Thanks for your help.

Melissa
 
M

MelissaDeMille

OK, as I suspected, I have another question. This works, I have linked to
using the data valadation feature, and input my information for an error
message when a value that is not in the list is entered. I do not get those
error messages, and am allowed to enter information that is not in the list.
I have tested it using just the list, the problem is that I would prefer to
have the autocomlete feature that you get with the combo box. Any help would
be appreciated.

Thanks again.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top