randallburdett
New Member
- Joined
- Sep 11, 2011
- Messages
- 1
Greetings,
I need a little help and I think this is the best place to get it. I recently added some VBA code to a spreadsheet to provide a dynamic search of Validation Lists. The code works great except for two issues incurred afterward:
1. I lost the ability to copy and paste items on the spreadsheet. I can highlight an item (non validation list item) , right click and select copy, but when I right click on a cell to paste, the option is grayed out.
2. The Validation List no longer validate. I can enter "123" (not in the list) and press enter, it will place it in the cell.
Below is the code I used, I am not a programmer I GTS'ed the functionality I was looking for and found it on the web.
Any advise/suggestions are appreciated.
Thanks,
Randall
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("Lists")
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left - 3
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 2
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet(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("TempCombo")
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
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
Case Else
End Select
End Sub
I need a little help and I think this is the best place to get it. I recently added some VBA code to a spreadsheet to provide a dynamic search of Validation Lists. The code works great except for two issues incurred afterward:
1. I lost the ability to copy and paste items on the spreadsheet. I can highlight an item (non validation list item) , right click and select copy, but when I right click on a cell to paste, the option is grayed out.
2. The Validation List no longer validate. I can enter "123" (not in the list) and press enter, it will place it in the cell.
Below is the code I used, I am not a programmer I GTS'ed the functionality I was looking for and found it on the web.
Any advise/suggestions are appreciated.
Thanks,
Randall
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("Lists")
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left - 3
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 2
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet(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("TempCombo")
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
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
Case Else
End Select
End Sub