Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
I am using the file downloaded from
http://www.contextures.com/excelfiles.html called DV0043 - Data Validation Combobox With Entry Check. I copied and pasted the example code and created the combo box but am having one issue. No mater what I select from the drop down list, when I change fields I get the error message that what I selected is not a valid value. I've traced the error message in the code but do not understand why when I moved it to my spreadsheet I would get this error no matter what I select. CODE FOLLOWS: Option Explicit Dim strTargAdd As String Private Sub TempCombo_Change() strTargAdd = ActiveCell.Address End Sub Private Sub TempCombo_LostFocus() Dim rngTarget As Range Dim lDVType As Long Dim strList As String Dim rngList As Range Dim wsLists As Worksheet Dim lCount As Long Dim strOldValue As String On Error Resume Next Set rngTarget = Range(strTargAdd) strOldValue = rngTarget.Value Set wsLists = Worksheets("Mileage") lDVType = rngTarget.Validation.Type ***HERE IS WHERE THE ERROR COMES FROM*** If lDVType = 3 Then strList = rngTarget.Validation.Formula1 rngList = wsLists.Range(Right(strList, Len(strList) - 1)) lCount = WorksheetFunction.CountIf(rngList, strOldValue) If lCount 0 Then ' do nothing Else rngTarget.Value = "" MsgBox strOldValue & " is not a valid entry for cell " & strTargAdd End If End If 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("Mileage") 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 .Top = Target.Top .Width = Target.Width + 15 .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 = False If Application.CutCopyMode Then 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.ScreenUpdating = True Application.EnableEvents = True Exit Sub End Sub I'd appreciate ANY assistance to resolve this problem TIA! |
#2
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
There's an error in the code. This line:
rngList = wsLists.Range(Right(strList, Len(strList) - 1)) should start with Set: Set rngList = wsLists.Range(Right(strList, Len(strList) - 1)) Thanks for pointing out the problem, and I've uploaded a revised version of the workbook. Joseph Bowen wrote: I am using the file downloaded from http://www.contextures.com/excelfiles.html called DV0043 - Data Validation Combobox With Entry Check. I copied and pasted the example code and created the combo box but am having one issue. No mater what I select from the drop down list, when I change fields I get the error message that what I selected is not a valid value. I've traced the error message in the code but do not understand why when I moved it to my spreadsheet I would get this error no matter what I select. CODE FOLLOWS: Option Explicit Dim strTargAdd As String Private Sub TempCombo_Change() strTargAdd = ActiveCell.Address End Sub Private Sub TempCombo_LostFocus() Dim rngTarget As Range Dim lDVType As Long Dim strList As String Dim rngList As Range Dim wsLists As Worksheet Dim lCount As Long Dim strOldValue As String On Error Resume Next Set rngTarget = Range(strTargAdd) strOldValue = rngTarget.Value Set wsLists = Worksheets("Mileage") lDVType = rngTarget.Validation.Type ***HERE IS WHERE THE ERROR COMES FROM*** If lDVType = 3 Then strList = rngTarget.Validation.Formula1 rngList = wsLists.Range(Right(strList, Len(strList) - 1)) lCount = WorksheetFunction.CountIf(rngList, strOldValue) If lCount 0 Then ' do nothing Else rngTarget.Value = "" MsgBox strOldValue & " is not a valid entry for cell " & strTargAdd End If End If 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("Mileage") 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 .Top = Target.Top .Width = Target.Width + 15 .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 = False If Application.CutCopyMode Then 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.ScreenUpdating = True Application.EnableEvents = True Exit Sub End Sub I'd appreciate ANY assistance to resolve this problem TIA! -- Debra Dalgleish Contextures http://www.contextures.com/tiptech.html |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Problem with Data Validation and limiting characters | Excel Worksheet Functions | |||
Data validation problem | Excel Discussion (Misc queries) | |||
Excel Macro to Copy & Paste | Excel Worksheet Functions | |||
Help PLEASE! Not sure what answer is: Match? Index? Other? | Excel Worksheet Functions | |||
Sort pages? | Excel Discussion (Misc queries) |