Predictive Data validation

[Roderick_E]

So I created some VBA to loop through either a direct manually input data validation set or a named range and automatically pick the entry that matches the string a user types in.
For example, say you had a list of U.S. state names and the user starts typing New y and presses enter, it would return New York since that would be in the list.
The problem I'm having is that worksheet change is continuing to trigger and gets stuck in a recursive loop. Can someone suggest changes to my code? Thanks
(P.S. turn off data validate error alert for it to work) Keep in mind if you test this as it you will also get stuck in the loop. ctrl+break to get out.)

Option Compare Text 'ignore text case
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String
Dim strarray As String
Dim strunbound() As String
Dim i As Long
Dim noff As Long 'noff = no freeform, set to 1 if you don't want to allow freeform input
noff = 1
If IsNumeric(Target.SpecialCells(xlCellTypeSameValidation).Cells.Count) Then
If Trim(Target) = "" Then
Exit Sub
End If
strarray = Target.Validation.Formula1
If InStr(strarray, "=") > 0 Then
str = Replace(strarray, "=", "")
strarray = "" 'reset
For Each c In Range(Application.ActiveWorkbook.Names(str).RefersTo)
strarray = strarray & c & ","
Next c
strarray = Left(strarray, Len(strarray) - 1) 'to delete trailing comma
End If


strunbound = Split(strarray, ",")
For i = LBound(strunbound) To UBound(strunbound)
If InStr(strunbound(i), Target) > 0 Then
Target.Value = strunbound(i)
Exit Sub
End If
Next i
If noff = 1 Then
strarray = Target
Target.Value = ""
'Target.Select
MsgBox strarray & " does not match in list.", vbCritical, "ERROR"
Exit Sub
End If
End If
End Sub

 

[Fluff]

Put

application.EnableEvents=False

at the top & then again at the end but with True

 

[Roderick_E]

Put

application.EnableEvents=False

at the top & then again at the end but with True

Dang! why do I forget the simple things? Thanks. Here's my altered code in case anyone wants to use it.

Option Compare Text 'ignore text case
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String
Dim strarray As String
Dim strunbound() As String
Dim i As Long
Dim noff As Long 'noff = no freeform, set to 1 if you don't want to allow freeform input
noff = 1
'to keep from triggering it user selects from dropdown
If Target.Address = ActiveCell.Address Then
Exit Sub
End If


If IsNumeric(Target.SpecialCells(xlCellTypeSameValidation).Cells.Count) Then
If Trim(Target) = "" Then
Exit Sub
End If
strarray = Target.Validation.Formula1
Application.EnableEvents = False
If InStr(strarray, "=") > 0 Then
str = Replace(strarray, "=", "")
strarray = "" 'reset
For Each c In Range(Application.ActiveWorkbook.Names(str).RefersTo)
strarray = strarray & c & ","
Next c
strarray = Left(strarray, Len(strarray) - 1) 'to delete trailing comma
End If


strunbound = Split(strarray, ",")
For i = LBound(strunbound) To UBound(strunbound)
If InStr(strunbound(i), Target) > 0 Then
Target.Value = strunbound(i)
Application.EnableEvents = True
Exit Sub
End If
Next i
If noff = 1 Then
strarray = Target
Target.Value = ""
Target.Select
MsgBox strarray & " does not match in list.", vbCritical, "ERROR"
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End If


End Sub

 

[Roderick_E]

More dang! -- the code from above posting will still cause errors if the user types in a cell other than a data validation field. Fixed in code below:

Option Compare Text 'ignore text case
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String
Dim strarray As String
Dim strunbound() As String
Dim i As Long
Dim noff As Long 'noff = no freeform, set to 1 if you don't want to allow freeform input
noff = 1
'to keep from triggering if user selects from dropdown
If Target.Address = ActiveCell.Address Then
Exit Sub
End If


On Error Resume Next
If IsError(Target.SpecialCells(xlCellTypeSameValidation).Cells.Count) = True Then
Exit Sub
End If
Resume Next


If IsNumeric(Target.SpecialCells(xlCellTypeSameValidation).Cells.Count) Then
If Trim(Target) = "" Then
Exit Sub
End If


strarray = Target.Validation.Formula1
Application.EnableEvents = False
If InStr(strarray, "=") > 0 Then
str = Replace(strarray, "=", "")
strarray = "" 'reset
For Each c In Range(Application.ActiveWorkbook.Names(str).RefersTo)
strarray = strarray & c & ","
Next c
strarray = Left(strarray, Len(strarray) - 1) 'to delete trailing comma
End If


strunbound = Split(strarray, ",")
For i = LBound(strunbound) To UBound(strunbound)
If InStr(strunbound(i), Target) > 0 Then
Target.Value = strunbound(i)
Application.EnableEvents = True
Exit Sub
End If
Next i
If noff = 1 Then
strarray = Target
Target.Value = ""
Target.Select
MsgBox strarray & " does not match in list.", vbCritical, "ERROR"
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End If


End Sub

 

[Roderick_E]

Now how to handle if the data validation is using a formula instead of a named range?

=OFFSET(functions!$J$4,0,0,COUNTIF(functions!$J$4:$J$65536,"> "))

The above code allows for a dynamic list that begins at J4 on a tab named functions and could extend to row 65536 (unlikely). That formula is placed in the data validation source field. How do I handle it?