Creating sql string for vba query with wildcard characters

Excel 2010 vba

I'm taking a text string from a cell
Splitting that into an array.

The code works fine UNLESS i only have one Token. i.e. FLAPPER OR VALVE

I'm creating the end of the "WHERE" clause in my sql statement.

for ONE word, two word and/or three word strings.

    lk = "Like"
    lm = " WwgCore.RICHTEXT "
    
    cD = Trim(cD)
    cD = Replace(cD, "  ", " ")
    cD = Replace(cD, ",", " ")
    cD = Replace(cD, "#", "")
    cD = Replace(cD, """", "")

    ' how many items are in the cell ?  build an array
            
    nF1 = cD
            
    cArrSql = Split(nF1, " ")
            
    ' search through the cell requests tokens.
    For x = LBound(cArrSql) To UBound(cArrSql)
        If x = UBound(cArrSql) Then
            nF1 = Trim(nF1 & " " & Chr(34) & "%" & cArrSql(x) & "%" & Chr(34))
               
        Else
            If x = 0 Then
                nF1 = Trim(Chr(34) & "%" & cArrSql(x) & "%" & Chr(34) & " AND" & lm & lk & " ")
            
            Else
                nF1 = Trim(nF1 & " " & Chr(34) & "%" & cArrSql(x) & "%" & Chr(34) & " AND" & lm & lk & " ")
            
            End If
        End If
    Next

    rng2 = nf1

Open in new window

The end of my WHERE clause is:
strsql = strsql & "WHERE WwgCore.RICHTEXT LIKE " & rng2 & ";"

for 2 tokens the string looks like this :
rng2 = "%FLAPPER%" AND WwgCore.RICHTEXT Like "%VALVE%" and the code works fine

ultimately nf1 for One Word token should be passed as "%FLAPPER%"

per above example:

But does not work for ONE word tokens

Thanks
fordraiders

VBAMicrosoft Excel

Last Comment

Bill Prew

8/22/2022 - Mon

Bill Prew

2/15/2016

If you debug the code, and watch or display strsql after you build it, what does it show as. before it doesn't work?

~bp

Fordraiders

2/15/2016

ASKER

with 2 tokens that work.

"%FLAPPER%" AND WwgCore.RICHTEXT Like "%VALVE%";

aikimark

2/15/2016

It would help the experts if you posted some example inputs to this code snippet.

Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!

Walt Forbes

ASKER CERTIFIED SOLUTION

Bill Prew

2/16/2016

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.

View this solution by signing up for a free trial.

Members can start a 7-Day free trial and enjoy unlimited access to the platform.

See Pricing Options

Start Free Trial

GET A PERSONALIZED SOLUTION

Ask your own question & get feedback from real experts

Find out why thousands trust the EE community with their toughest problems.

aikimark

2/16/2016

Here is a different approach.
Notes:

* Force explicit variable declaration (best practices)
* Use Regexp object to do the cleaning and parsing
* Retain Bill's Quote() function
* Use Join() function to add the " AND " strings
* Return a valid Where clause if nothing parsed

Option Explicit

Sub Q_28926419()
    Dim rng2, strsql
    rng2 = BuildWhere("FLAPPER ""234"" #$@@ buzzkill")
    strsql = strsql & rng2 & ";"
    Debug.Print strsql
End Sub


Function BuildWhere(ByVal cD As String)
    Const lmlk = "WwgCore.RICHTEXT Like "
    Dim cArrSql() As String
    
    Static oRE As Object
    Dim oMatches As Object
    Dim oM As Object
    Dim lngSM As Long

    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.Pattern = "[0-9A-Za-z]+"
    End If

    If oRE.test(cD) Then
        Set oMatches = oRE.Execute(cD)
        ReDim cArrSql(1 To oMatches.Count)
        lngSM = 1
        For Each oM In oMatches
            cArrSql(lngSM) = lmlk & Quote("%" & oM.Value & "%")
            lngSM = lngSM + 1
        Next
    Else
        BuildWhere = "WHERE 0=1"
    End If

    BuildWhere = "WHERE " & Join(cArrSql, " AND ")
 
End Function

Function Quote(ByVal strText As String)
    Quote = Chr(34) & strText & Chr(34)
End Function