How to test for characters in a specific set?

[Jennifer]

Is there a way for me to test whether a UDF string parameter contains only characters from a predefined character set without having to loop through each character?

Function MyFun(Code As String) As Double
Const CharSet As String = "ANP*-$#"
 . . .

How can I test whether Code contains only characters in CharSet?

[YasserKhalil]

I don't think it is possible without loops. It would loop each character to check its existence

[Jennifer]

I don't think it is possible without loops. It would loop each character to check its existence

Rats. That's what I was afraid of. Thanks.

[GTO]

Greetings Jennifer,

Maybe a simple RegExp?

Option Explicit
  
Public Function udfCharSet(ByVal CellText As String, Optional ByVal CharSet As String = "ANP*-$#") As Boolean
Static REX As Object
Dim n As Long
Dim sTmp As String
  
  'Static, as an IF is quicker than setting a new reference each call
  If REX Is Nothing Then
    Set REX = CreateObject("VBScript.RegExp")
  End If
  
  ' In case the cell is empty
  If CellText = vbNullString Then
    udfCharSet = True
    Exit Function
  End If
  
  ' Add a backslash to precede each character to insist literal.  If CharSet will actually
  ' be constant, then you don't need this, but do need to add a backslash to the pattern
  ' in front of stuff like '*'.  See https://msdn.microsoft.com/en-us/library/ms974570.aspx
  For n = Len(CharSet) To 1 Step -1
    sTmp = "\" & Mid$(CharSet, n, 1) & sTmp
  Next
  
  With REX
    .Global = False
    .IgnoreCase = False
    .Pattern = "[^" & sTmp & "]"
    udfCharSet = Not .Test(CellText)
  End With
  
End Function

Hope that helps,

Mark

[snb]

Msgbox instr("aaaa ANP*-$# bbbb","ANP*-$#" )

[Paul_Hossler]

There used to be a Windows API (Shlwapi.dll) that would do it, but I don't think it's available any more

I think that some kind of loop is needed, but you can make it as efficient as possible

I tried adding logic to remove duplicated characters from the string being tested, but that added processing time some it just seemed more efficient to keep it simple

So in the example, 'A' is checked 4 times in "AAAANNNPPP****----$$$$$#####"

Option Explicit
Function OnlyCertainChar(OnlyTheseAllowed As String, CheckThis As String) As Boolean
    Dim i As Long
    
    OnlyCertainChar = False
    
    For i = 1 To Len(CheckThis)
        If InStr(OnlyTheseAllowed, Mid(CheckThis, i, 1)) = 0 Then Exit Function
    Next I
    
    OnlyCertainChar = True
End Function


Sub test()
    MsgBox OnlyCertainChar("ANP*-$#", "ZAAAANNNPPP****----$$$$$#####")
    MsgBox OnlyCertainChar("ANP*-$#", "AAAANNNPPP****----$$$$$#####")

End Sub

[snb]

msgbox replace(replace(replace(replace(replace(replace(replace("aaaa ANP*-$# bbbb","A",""),"N",""),"P",""),"*",""),"-",""),"$",""),"#","")=""

[GTO]

Maybe I am misunderstanding, but as I understand it, I think w/o a loop...

Option Explicit
  
Public Function udfCharSetConst(ByVal CellText As String) As Boolean
    Static REX As Object
    Dim n As Long
    Dim sTmp As String
    
    If REX Is Nothing Then
        Set REX = CreateObject("VBScript.RegExp")
    End If
    
    If CellText = vbNullString Then
        udfCharSetConst = True
        Exit Function
    End If
     
    With REX
        .Global = False
        .IgnoreCase = False
        .Pattern = "[^ANP\*\-\$#]"
        udfCharSetConst = Not .Test(CellText)
    End With
     
End Function

[Paul_Hossler]

Another approach that tries to avoid string manipulation trades speed for complexity

This uses integer arrays and a 'quick exit' if the string being checked has a char max/min that exceeds the max/min of the allowed characters. No looping this way

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal bytes As Long)

Function OnlyCertainChar1(ByVal OnlyTheseAllowed As String, ByVal CheckThis As String) As Boolean
    Dim i As Long, x As Long
    Dim aOnly() As Integer, aCheck() As Integer
    
    ReDim aOnly((LenB(OnlyTheseAllowed) - 1) \ 2)
    ReDim aCheck((LenB(CheckThis) - 1) \ 2)
    
    
    CopyMemory aOnly(0), ByVal StrPtr(OnlyTheseAllowed), LenB(OnlyTheseAllowed)
    CopyMemory aCheck(0), ByVal StrPtr(CheckThis), LenB(CheckThis)
    
    
    With Application.WorksheetFunction
    
        'quick check
        OnlyCertainChar1 = False
        If .Max(aCheck) > .Max(aOnly) Then Exit Function
        If .Min(aCheck) < .Min(aOnly) Then Exit Function
            
        'slower check
        OnlyCertainChar1 = True
        
        On Error GoTo NotOnList
        For i = LBound(aCheck) To UBound(aCheck)
            x = .Match(aCheck(i), aOnly, 0)
        Next I
        
        Exit Function
    End With
    
NotOnList:
    OnlyCertainChar1 = False
End Function

Sub test()
    MsgBox OnlyCertainChar1("ANP*-$#", "ZAAAANNNPPP****----$$$$$#####")
    MsgBox OnlyCertainChar1("ANP*-$#", "AAAANNNPPP****----$$$$$#####")
End Sub