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
LVL 3
FordraidersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewIT / Software Engineering ConsultantCommented:
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
FordraidersAuthor Commented:
with 2 tokens that work.

"%FLAPPER%" AND WwgCore.RICHTEXT Like "%VALVE%";
aikimarkCommented:
It would help the experts if you posted some example inputs to this code snippet.
Angular Fundamentals

Learn the fundamentals of Angular 2, a JavaScript framework for developing dynamic single page applications.

Enroll Today!
Bill PrewIT / Software Engineering ConsultantCommented:
You problem stems from the boundary condition where UBound = LBound.  This occurs when only one word is being parsed, and the logic fails.

I rewrote the logic to work better I think, and it will handle that case and the multiwords as well.  See if this makes sense and if it works better.  The WHERE clause is now entirely generated by the function, so notice the concatenation to the base SQL is slightly different.  I also like to do the quoting in a function, easier to read later I think.

rng2 = BuildWhere("FLAPPER")
strsql = strsql & rng2 & ";"

Function BuildWhere(cD As String)

    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
    cArrSql = Split(cD, " ")
        
    ' search through the cell requests tokens.
    For x = LBound(cArrSql) To UBound(cArrSql)
        If x = LBound(cArrSql) Then
            nf1 = "WHERE " & lm & " Like " & Quote("%" & cArrSql(x) & "%")
        Else
            nf1 = nf1 & " AND " & lm & " Like " & Quote("%" & cArrSql(x) & "%")
        End If
    Next
 
    BuildWhere = nf1
 
End Function

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

Open in new window

~bp

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
aikimarkCommented:
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

Open in new window

aikimarkCommented:
You can also iterate the matches numerically.
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 lngM 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(0 To oMatches.Count - 1)
        For lngM = 0 To oMatches.Count - 1
            cArrSql(lngM) = lmlk & Quote("%" & oMatches(lngM).Value & "%")
        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

Open in new window

FordraidersAuthor Commented:
Thanks Guys, As always great help !!
Bill PrewIT / Software Engineering ConsultantCommented:
Welcome.

~bp
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.