I am looking for assisitance in combining the functionality of two seperate
combo box code sets. The first combo box code set allows the combo box to
automaticially appear when a user Clicks on a cell that contains a data
validation list. The second set of code will have a combo box appear when a
user Double-clicks on a cell that contains a data validation list. And the
code allows for Named Ranges on a seperate worksheet.
I would like to have the functionality of having the combo box to appear
when a user Clicks on a cell and not having to Double-click. Also, I would
like to have the option to use Named Ranges on a seperate worksheet
("Validation Lists").
I would appreciate any assistance that can be given. Thank you! The code for
both sets is listed below.
Data Validation -- Combo box -- Click
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
On Error Goto errHandler
If Target.Count > 1 Then Goto exitHandler
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If
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 + 15
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
exitHandler:
Application. ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
Resume exitHandler
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
'====================================
Data Validation -- Combo box using Named Ranges
'==========================
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("TempCombo")
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
If Application.CutCopyMode Then
'allow copying and pasting on the worksheet
Goto errHandler
End If
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 '====================================
'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
'====================================
|
Similar Threads
