Hello VBA Masters,
The below is a code which is from this website. it makes a datasheet with drop down list into a search and fill form by using a combo box. The code works for both the drown down formulas . i.e. it works when I use’ named range’ field and also an INDIRECT($A$2) formula. The problem I have is that the code goes through the whole spreadsheet and looks for EVERY dropdown in the sheet and it becomes an issue at times – especially when I have use a data field as a drop down list.
Can I get the code to only work for certain cells? – For example I want it to work for Whole column B and C and D. but the remaining sheet should be normal dropdown boxes.
Your help would be much appreciated.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
'Dim wslist As Worksheet
Set ws = ActiveSheet
Set sh1 = ActiveWorkbook.Sheets("lookupdata")
Set sh2 = ActiveWorkbook.Sheets("loccountries")
Set sh3 = ActiveWorkbook.Sheets("loccities")
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.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
If Left(str, Len("=INDIRECT(")) = "=INDIRECT(" Then
str = Mid(str, Len("=INDIRECT(") + 1)
str = Left(str, Len(str) - 1)
str = Evaluate(str)
strAddress = "'" & Application.Names(str).RefersToRange.Parent.Name & "'!" & _
Application.Names(str).RefersToRange.Address
Else
str = Right(str, Len(str) - 1)
strAddress = str
End If
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 = strAddress
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
Resume exitHandler
End Sub
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
'change text value to number, if possible
On Error Resume Next
Select Case KeyCode
Case 9 'Tab - change text to number, move right
ActiveCell.Value = --ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter - change text to number, move down
ActiveCell.Value = --ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
Bookmarks