Sunday, May 12, 2013

Simple asterisk filter function for strings

Took a bit of thinking to achieve this. This function processes a given string and tells whether it is in agreement with the provided filter input. It accepts the wildcard filter character, asterisk(*) only.
It returns TRUE if the given 'name' parameter is compatible with the provided 'filter' parameter.

Private Function FilterCompliant(ByVal name As String, ByVal filter As String) As Boolean
'//Author : s0ft
'//Contact : aayush.babu@yahoo.com
'//Blog : http://www.c0dew0rth.blogspot.com
'//Usage : Returns TRUE if the given 'name' string is compliant with the given 'filter'
'//it is crucial to understand the working of the asterisk * wildcard character to make a function that processes it
filter = LCase$(filter)
name = LCase$(name)
If filter = "*" Then
    FilterCompliant = True
    Exit Function
End If
Dim splitparts() As String
splitparts = Split(filter, "*")
If splitparts(0) = "" Then splitparts(0) = Left$(name, 1) '//if filter starts with * like e.g *gr*q then make splitparts(0) which would otherwise be "" the first letter of the name
nextstart = 1 '//tells from where to start looking for between-the-asterisk-characters in filter var
For i = 0 To UBound(splitparts)
If Left$(filter, InStr(filter, "*") - 1) = Left$(name, InStr(filter, "*") - 1) Then '//whether *sth or go*sth, the first character(s)-before-asterisk must be the same in filter and name var. So this is a necessary condition
    If InStr(nextstart, name, splitparts(i)) <> 0 Then '//search from nextstart position the string splitparts(i) in name var
        nextstart = InStr(nextstart, name, splitparts(i)) + Len(splitparts(i)) '//so that next time instr wont count the same letter
        cnt = cnt + 1
    Else
        Exit For
    End If
End If
Next i
If cnt = UBound(splitparts) + 1 Then '//necessary condition
    If Right$(filter, 1) = "*" Then '//if filter is in format:  hehe*
        FilterCompliant = True
    ElseIf StrReverse(Left$(StrReverse(filter), InStr(StrReverse(filter), "*") - 1)) = Right$(name, InStr(StrReverse(filter), "*") - 1) Then '//if input is in format: comp*r then give YES to only those words with the same after-final-asterisk-character(s)
        FilterCompliant = True
    End If
End If
End Function



Usage example:

Private Sub Form_Load()
Debug.Print FilterCompliant("eloquent", "*oq*")
End Sub