Excel VBA Replacing Value When Text Entered is NOT in Array List

[rarascon]

Hi there: I've been looking at some other posts on replacing text entered with values from two arrays. Works when the values exist in the array; however, if the user enters a different value, then I'd like replace it with "". Please see what I have so far below, and let me know if you have any questions. My apologies for any junk code here. Thanks!

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

''''''''''''''''''''''''''''''''''''''''''''
'Force Y/N column to UPPER case

''''''''''''''''''''''''''''''''''''''''''''

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

    Dim str As String
    Dim fromList() As Variant, toList As Variant, i As Long  ', item

    fromList = Array("Y*", "YES", "y*", "yes", "y", "N*", "NO", "n*", "no", "n") 'text not allowed
    toList = Array("Y", "Y", "Y", "Y", "Y", "N", "N", "N", "N", "N") 'text allowed
    str = Target.Value

    'On Error Resume Next

    If Not Intersect(Target, Range("G3:G5000")) Is Nothing Then

        Application.EnableEvents = False
        'Target = UCase(Target)
        
   '     For Each item In fromList    'replace all items in fromList with ""
   '        str = Replace(str, item, "")
   '     Next item
        
    With Range("G3", Cells(Rows.Count, "G").End(xlUp))
        
        'str = Replace(str, i, "")
        
        For i = LBound(fromList) To UBound(fromList)
        If i <= UBound(fromList) Then str = Replace(str, fromList(i), "")
            
            .Replace _
                What:=fromList(i), Replacement:=toList(i), _
                MatchCase:=True

        Next
    End With
        Application.EnableEvents = True

    End If

    On Error GoTo 0


End Sub

 

[kevin9999]

Maybe...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("G3", Cells(Rows.Count, "G").End(xlUp)), Target) Is Nothing Then
        Application.EnableEvents = False
        Dim fromList, toList, i As Long
        
        fromList = Array("Y*", "YES", "y*", "yes", "y", "N*", "NO", "n*", "no", "n")
        toList = Array("Y", "Y", "Y", "Y", "Y", "N", "N", "N", "N", "N")
        
        For i = LBound(fromList) To UBound(fromList)
            If Target.Value = fromList(i) Then Target.Value = toList(i)
        Next i
        
        If Not IsNumeric(Application.Match(Target.Value, toList, 0)) Then Target.Value = ""
        
       Application.EnableEvents = True
    End If
End Sub

 

[dmt32]

Hi,
if you just want to force user entry of the words Yes or No to an upper case single character then maybe this will do what you want

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    
    ''''''''''''''''''''''''''''''''''''''''''''
    'Force Y/N column to UPPER case
    
    ''''''''''''''''''''''''''''''''''''''''''''
    On Error GoTo exitsub
    If Target.Cells.CountLarge > 1 Then Exit Sub
    
    If Not Intersect(Target, Columns(7)) Is Nothing Then
        Application.EnableEvents = False
        With Target
            If UCase(.Value) Like "[YN]*" Then _
               .Value = UCase(Left(.Value, 1)) Else .Value = ""
        End With
    End If
    
exitsub:
    Application.EnableEvents = True
End Sub

but wonder why not just us data validation in the range for users to select required entry?

Color coding Yes or No drop-down list in Excel

www.extendoffice.com

Dave

 

[rarascon]

Hi,
if you just want to force user entry of the words Yes or No to an upper case single character then maybe this will do what you want

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   
    ''''''''''''''''''''''''''''''''''''''''''''
    'Force Y/N column to UPPER case
   
    ''''''''''''''''''''''''''''''''''''''''''''
    On Error GoTo exitsub
    If Target.Cells.CountLarge > 1 Then Exit Sub
   
    If Not Intersect(Target, Columns(7)) Is Nothing Then
        Application.EnableEvents = False
        With Target
            If UCase(.Value) Like "[YN]*" Then _
               .Value = UCase(Left(.Value, 1)) Else .Value = ""
        End With
    End If
   
exitsub:
    Application.EnableEvents = True
End Sub

but wonder why not just us data validation in the range for users to select required entry?

Color coding Yes or No drop-down list in Excel

www.extendoffice.com

Dave

Thanks, Dave, and I will check this out shortly. I did but then I wanted to automate any variations and lower case values, which I know can be done with formulas but I thought I'd try this option.

 

[rarascon]

Thanks, Dave, and I will check this out shortly. I did but then I wanted to automate any variations and lower case values, which I know can be done with formulas but I thought I'd try this option.

Yep - that did the trick. I was hoping to find a more stripped down version of code, and this is perfect. Appreciate it!

 

[dmt32]

welcome glad we were able to help & appreciate feedback

Dave