VBA and SQL to return SQL results to Excel

Question

Now that I finally have time to look back at this code I wrote over a year ago. I need help with streamlining the code I have written. I had to write a significant amount of IF statements to get this to work, but im thinking using functions anbd maybe dictionaries would be a much more efficient way to go about this code. My skills are still not the greatest, so some thoughts and examples with how to set this code up to not only run more efficiently, but also streamline the code itself will be of great use. This code does run and gives the desired results.

This code runs a SQL search from a IBM AS/400 server based on the criteria entered in by a user on a UserForm.

Dim wsCity As Range, wsState As Range, wsAgeL As Range, wsAgeU As Range, wsGender As Range, wsDOB As Range, wsAge As Range
Dim strConn As String, strSQL As String, uName As String, empName As String, lableCap As String, sqlCity As String, sqlState As String, sqlGender As String
Dim CS As New ADODB.Connection, RS As New ADODB.Recordset
Private Sub Search_Click()
    Dim wsDD As Worksheet
    Dim DOBRange As Range, AgeRange As Range
    Dim CitySQL As String, StateSQL As String, DOBSQL As String, CustSQL As String, sqlAgeLStr As String, sqlAgeUStr As String, sqlAgeBStr As String
    Dim lastRowDOB As Long, lastRowAge As Long, i As Long, lastx As Long
    Dim cell
    Dim x As Long, a As Integer, aLower As Integer, aUpper As Integer

    Set CS = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")

    Set wsCity = DE.Range("City")
    Set wsState = DE.Range("State")
    Set wsDOB = DE.Range("DOB")
    Set wsGender = DE.Range("Gender")
    Set wsAgeL = DE.Range("AgeLower")
    Set wsAgeU = DE.Range("AgeUpper")

    aLower = wsAgeL
    aUpper = wsAgeU

    sqlAgeLStr = "TIMESTAMPDIFF(256, CHAR(TIMESTAMP(CURRENT TIMESTAMP) - TIMESTAMP(DATE(DIGITS(DECIMAL(cfdob7 + 0.090000, 7, 0))), CURRENT TIME))) >=  " & aLower & "" & ""
    Debug.Print sqlAgeLStr
    sqlAgeUStr = "TIMESTAMPDIFF(256, CHAR(TIMESTAMP(CURRENT TIMESTAMP) - TIMESTAMP(DATE(DIGITS(DECIMAL(cfdob7 + 0.090000, 7, 0))), CURRENT TIME))) >=  " & aUpper & "" & ""
    Debug.Print sqlAgeUStr
    sqlAgeBStr = "TIMESTAMPDIFF(256, CHAR(TIMESTAMP(CURRENT TIMESTAMP) - TIMESTAMP(DATE(DIGITS(DECIMAL(cfdob7 + 0.090000, 7, 0))), CURRENT TIME))) BETWEEN " & aLower & " AND " & aUpper & ""
    Debug.Print sqlAgeBStr

    Application.ScreenUpdating = False

    strConn = REDACTED FOR PUBLIC VIEWING

    sqlCity = wsCity.Value
    sqlState = wsState.Value
    sqlGender = wsGender.Value

    strSQL = "SELECT " & _
                "cfna1,CFNA2,CFNA3,CFCITY,CFSTAT,LEFT(CFZIP,5) FROM CNCTTP08.JHADAT842.CFMAST CFMAST " & _
                "WHERE cfdob7 != 0 AND cfdob7 != 1800001 AND CFDEAD = 'N' AND "

    a = 0

'SEARCHES BY CITY ONLY
    If wsCity.Value <> vbNullString And wsState.Value = vbNullString And wsGender.Value = vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 1

'SEARCHES BY CITY AND STATE
    If wsCity.Value <> vbNullString And wsState.Value <> vbNullString And wsGender.Value = vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 2

'SEARCHES BY CITY AND GENDER
    If wsCity.Value <> vbNullString And wsState.Value = vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 3

'SEARCHES BY CITY AND AGE LOWER
    If wsCity.Value <> vbNullString And wsState.Value = vbNullString And wsGender.Value = vbNullString And _
    wsAgeL <> vbNullString And wsAgeU = vbNullString Then a = 4

'SEARCHES BY CITY AND AGE UPPER
    If wsCity.Value <> vbNullString And wsState.Value = vbNullString And wsGender.Value = vbNullString And _
    wsAgeL = vbNullString And wsAgeU <> vbNullString Then a = 5

'SEARCHES BY CITY AND FULL AGE RANGE
    If wsCity.Value <> vbNullString And wsState.Value = vbNullString And wsGender.Value = vbNullString And _
    wsAgeL <> vbNullString And wsAgeU <> vbNullString Then a = 6

'SEARCHES BY CITY, GENDER AND FULL AGE RANGE
    If wsCity.Value <> vbNullString And wsState.Value = vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL <> vbNullString And wsAgeU <> vbNullString Then a = 7

'SEARCHES BY CITY, STATE AND GENDER
    If wsCity.Value <> vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 8

'SEARCHES BY CITY, STATE, GENDER AND LOWER AGE
    If wsCity.Value <> vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL <> vbNullString And wsAgeU = vbNullString Then a = 9

'SEARCHES BY CITY, STATE, GENDER, UPPER AGE RANGE
    If wsCity.Value <> vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL = vbNullString And wsAgeU <> vbNullString Then a = 10

'SEARCHES BY CITY, STATE, GENDER, FULL AGE RANGE
    If wsCity.Value <> vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL <> vbNullString And wsAgeU <> vbNullString Then a = 11

'SEARCHES BY STATE
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value = vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 12

'SEARCHES BY STATE AND GENDER
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 13

'SEARCHES BY STATE AND AGE LOWER
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value = vbNullString And _
    wsAgeL <> vbNullString And wsAgeU = vbNullString Then a = 14

'SEARCHES BY STATE AND AGE UPPER
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value = vbNullString And _
    wsAgeL = vbNullString And wsAgeU <> vbNullString Then a = 15

'SEARCHES BY STATE AND FULL AGE RANGE
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value = vbNullString And _
    wsAgeL <> vbNullString And wsAgeU <> vbNullString Then a = 16

'SEARCHES BY STATE, GENDER AND AGE LOWER
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL <> vbNullString And wsAgeU = vbNullString Then a = 17

'SEARCHES BY STATE, GENDER AND AGE UPPER
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL = vbNullString And wsAgeU <> vbNullString Then a = 18

'SEARCHES BY STATE, GENDER AND FULL AGE RANGE
    If wsCity.Value = vbNullString And wsState.Value <> vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL <> vbNullString And wsAgeU <> vbNullString Then a = 19

'SEARCHES BY GENDER
    If wsCity.Value = vbNullString And wsState.Value = vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 20

'SEARCHES BY GENDER AND AGE LOWER
    If wsCity.Value = vbNullString And wsState.Value = vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL <> vbNullString And wsAgeU = vbNullString Then a = 21

'SEARCHES BY GENDER AND AGE UPPER
    If wsCity.Value = vbNullString And wsState.Value = vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL = vbNullString And wsAgeU <> vbNullString Then a = 22

'SEARCHES BY GENDER AND FULL AGE RANGE
    If wsCity.Value = vbNullString And wsState.Value = vbNullString And wsGender.Value <> vbNullString And _
    wsAgeL <> vbNullString And wsAgeU <> vbNullString Then a = 23

'SEARCHES BY LOWER AGE RANGE
    If wsCity.Value = vbNullString And wsState.Value = vbNullString And wsGender.Value = vbNullString And _
    wsAgeL <> vbNullString And wsAgeU = vbNullString Then a = 24

'SEARCHES BY UPPER AGE RANGE
    If wsCity.Value = vbNullString And wsState.Value = vbNullString And wsGender.Value = vbNullString And _
    wsAgeL = vbNullString And wsAgeU <> vbNullString Then a = 25

'SEARCHES BY FULL AGE RANGE
    If wsCity.Value = vbNullString And wsState.Value = vbNullString And wsGender.Value = vbNullString And _
    wsAgeL = vbNullString And wsAgeU = vbNullString Then a = 26

'SEARCHES BY CITY, STATE, FULL AGE RANGE
    If wsCity.Value <> vbNullString And wsState.Value <> vbNullString And wsGender.Value = vbNullString And _
    wsAgeL <> vbNullString And wsAgeU <> vbNullString Then a = 27


    Select Case a
        Case Is = 1 'SEARCHES BY CITY ONLY
            strSQL = strSQL & "CFCITY= '" & UCase(wsCity.Value) & "' AND " & _
                              "CFSEX != 'O'"
        Case Is = 2 'SEARCHES BY CITY AND STATE
            strSQL = strSQL & "CFSEX != 'O' AND " & _
                              "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              "CFSTAT = '" & UCase(wsState.Value) & "'"
        Case Is = 3 'SEARCHES BY CITY AND GENDER
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "'"
        Case Is = 4 'SEARCHES BY CITY AND AGE LOWER
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              sqlAgeLStr
        Case Is = 5 'SEARCHES BY CITY AND AGE UPPER
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              sqlAgeUStr
        Case Is = 6 'SEARCHES BY CITY AND FULL AGE RANGE
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              sqlAgeBStr
        Case Is = 7 'SEARCHES BY CITY, GENDER, AND FULL AGE RANGE
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              "CFSEX = '" & UCase(wsGender.Value) & "' AND " & _
                              sqlAgeBStr
        Case Is = 8 'SEARCHES BY CITY, STATE AND GENDER
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "'"
        Case Is = 9 'SEARCHES BY CITY, STATE, GENDER AND LOWER AGE
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeLStr
        Case Is = 10 'SEARCHES BY CITY, STATE, GENDER, UPPER AGE RANGE
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                              "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeUStr
        Case Is = 11 'SEARCHES BY CITY, STATE, GENDER, FULL AGE RANGE
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity) & "' AND " & _
                              "CFSTAT = '" & UCase(wsState) & "' AND " & _
                              "CFSEX = '" & UCase(wsGender) & "' AND " & _
                              sqlAgeBStr
        Case Is = 12 'SEARCHES BY STATE
            strSQL = strSQL & "CFSTAT= '" & UCase(wsState.Value) & "'"
        Case Is = 13 'SEARCHES BY STATE AND GENDER
            strSQL = strSQL & "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "'"
        Case Is = 14 'SEARCHES BY STATE AND AGE LOWER
            strSQL = strSQL & "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              sqlAgeLStr
        Case Is = 15 'SEARCHES BY STATE AND AGE UPPER
            strSQL = strSQL & "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              sqlAgeUStr
        Case Is = 16 'SEARCHES BY STATE AND FULL AGE RANGE
            strSQL = strSQL & "CFSTAT = '" & UCase(wsState.Value) & "') AND " & _
                              sqlAgeBStr
        Case Is = 17 'SEARCHES BY STATE, GENDER AND AGE LOWER
            strSQL = strSQL & "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeLStr
        Case Is = 18 'SEARCHES BY STATE, GENDER AND AGE UPPER
            strSQL = strSQL & "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeUStr
        Case Is = 19 'SEARCHES BY STATE, GENDER AND FULL AGE RANGE
            strSQL = strSQL & "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeBStr
        Case Is = 20 'SEARCHES BY GENDER
            strSQL = strSQL & "CFSEX = '" & wsGender & "'"
        Case Is = 21 'SEARCHES BY GENDER AND AGE LOWER
            strSQL = strSQL & "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeLStr
        Case Is = 22 'SEARCHES BY GENDER AND AGE UPPER
            strSQL = strSQL & "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeUStr
        Case Is = 23 'SEARCHES BY GENDER AND FULL AGE RANGE
            strSQL = strSQL & "CFSEX = '" & wsGender & "' AND " & _
                              sqlAgeBStr
        Case Is = 24 'SEARCHES BY LOWER AGE RANGE
            strSQL = strSQL & "CFSEX != 'O' AND " & _
                              sqlAgeLStr
        Case Is = 25 'SEARCHES BY UPPER AGE RANGE
            strSQL = strSQL & "CFSEX != 'O' AND " & _
                              sqlAgeUStr
        Case Is = 26 'SEARCHES BY FULL AGE RANGE
            strSQL = strSQL & "CFSEX != 'O' AND " & _
                              sqlAgeBStr
        Case Is = 27 'SEARCHES BY CITY, STATE, FULL AGE RANGE
            strSQL = strSQL & "CFCITY = '" & UCase(wsCity) & "' AND " & _
                              "CFSTAT = '" & UCase(wsState.Value) & "' AND " & _
                              sqlAgeBStr
    End Select

    strSQL = strSQL & " ORDER BY cfna1 ASC"
    Debug.Print strSQL

    DataEntry.Hide

    CS.Open (strConn)
    RS.Open strSQL, CS

    MarketingList.Range("B2").CopyFromRecordset RS

    RS.Close
    CS.Close

    Set RS = Nothing
    Set CS = Nothing

    Application.ScreenUpdating = True

    MarketingList.Activate
    FormatHeaders
    SearchComplete.Show

End Sub

Private Sub AgeLower_AfterUpdate()

    Set wsAgeL = DE.Range("AgeLower")

    wsAgeL = Format(DataEntry.AgeLower, "0")

End Sub

Private Sub AgeUpper_AfterUpdate()

    Set wsAgeU = DE.Range("AgeUpper")

    wsAgeU = Format(DataEntry.AgeUpper, "0")
End Sub

Private Sub City_AfterUpdate()

    Set wsCity = DE.Range("City")

    wsCity = DataEntry.City
End Sub
Private Sub Male_Click()

    Set wsGender = DE.Range("Gender")

    Select Case DataEntry.Male
        Case Is = True
            wsGender = "M"
        Case Is = False
            wsGender = vbNullString
    End Select

End Sub
Function OrdDateToDate(OrdDate As String) As Long
    Dim TheYear As Integer
    Dim TheDay As Integer
    Dim TheDate As Long

    TheYear = CInt(Left(OrdDate, 4))
    TheDay = CInt(Right(OrdDate, 3))
    TheDate = DateSerial(TheYear, 1, TheDaDE)
    OrdDateToDate = TheDate

End Function
Private Sub Female_Click()
    Set wsGender = DE.Range("Gender")

    Select Case DataEntry.Female
        Case Is = True
            wsGender = "F"
        Case Is = False
            wsGender = vbNullString
    End Select
End Sub

I'm sure reviewers will mention something about ADODB commands and parameters, but before we shred this code to pieces (aka "review"), can you confirm that this is the only procedure in the module? Basically what I'm curious about, is all these declarations outside the Search_Click() procedure scope: it would be helpful to know why they're where they are. Consider reviewing Rubberduck inspections, too; it can pick up and warn you about a lot of things reviewers will also tell you about. Cheers! — Mathieu Guindon, Commented Nov 11, 2019 at 18:58
@MathieuGuindon That is correct this code is all in the UserForm module. — Zack E, Commented Nov 11, 2019 at 19:15
@MathieuGuindon I placed all the code into one block. This was one of my first attempts at VBA, so i didnt place the Option Explicit at the top like I do with all my other code now. I will add it in. Thanks for the reminder. Unfortunately, in regards to RubberDuck I do need admin rights to download anything on my work computer :( — Zack E, Commented Nov 11, 2019 at 19:21
Ah, yes, requiring admin rights to fight evil, I know that problem. No problem, Mat is a walking, talking rubberduck. — Mast, Commented Nov 11, 2019 at 19:26
You don't need to edit your code further (at least in this question). The problems with it are perfectly reviewable :-) — Mast, Commented Nov 11, 2019 at 19:28

Greedo · Accepted Answer · 2019-11-12 15:37:26Z

Let's start with the easy stuff. At first glance the code looks horrendous but after taking a closer look well it is horrendous. JK for the most part you need to learn a few tricks that will greatly simplify the code.

Miscellaneous

As is, I see no reason for the class members because everyone of these fields are being set at each point of use. In this way, if one of the references changes you will have to update the reference at each point of use.

If would make more sense to set the fields one time when the userform is initialized.

Private rCity As Range, rState As Range, rAgeL As Range, rAgeU As Range, rGender As Range, rDOB As Range, rAge As Range

Private Sub UserForm_Initialize()
    Set rCity = DE.Range("City")
    Set rState = DE.Range("State")
    Set rDOB = DE.Range("DOB")
    Set rGender = DE.Range("Gender")
    Set rAgeL = DE.Range("AgeLower")
    Set rAgeU = DE.Range("AgeUpper")
End Sub

Why prefix the ranges with ws? Typically, ws signifies Worksheet.

wsCity As Range, wsState As Range, wsAgeL As Range, wsAgeU As Range, wsGender As Range, wsDOB As Range, wsAge As Range

Why use the New keyword if you are going to set the instances using CreateObject? There is no reason for Connection and Recordset to be fields. They should be local variables.

CS As New ADODB.Connection, RS As New ADODB.Recordset

What the heck are you setting a class member field for in a control AfterUpdate event?

Private Sub City_AfterUpdate()

   Set wsCity = DE.Range("City")

   wsCity = DataEntry.City
End Sub

Use helper variables to simplify and clarify you code. Unless you want to ensure that the user changes the value then don't bother setting your fields here.

Use Me instead of DataEntry.

Private Sub City_Change()   
    DE.Range("City") = Me.City.Value
End Sub

Sub Search_Click()

This is a bit of a mess. To begin with this Search_Click() is doing too much.

Setting Class Members
Establishing a Connection
Building a Query String
Executing the Query
Transferring the

The fewer tasks that a method performs the easier it is to test and modify.

By combining all the If statements using If and ElseIf, you could eliminate the Select Case block.

If Len(wsCity.Value) > 0 And Len(wsState.Value) = 0 And Len(wsGender.Value) = 0 And Len(    If Len(wsCity.Value) > 0 And Len(wsState.Value) = 0 And Len(wsGender.Value) = 0 And Len(wsAgeL) = 0 And Len(wsAgeU) = 0 Then
    Rem SEARCHES BY CITY ONLY
    strSQL = strSQL & "CFCITY= '" & UCase(wsCity.Value) & "' AND CFSEX != 'O'"
ElseIf Len(wsCity.Value) > 0 And Len(wsState.Value) > 0 And Len(wsGender.Value) = 0 And Len(wsAgeL) = 0 And Len(wsAgeU) = 0 Then
    Rem SEARCHES BY CITY AND STATE
        strSQL = strSQL & "CFSEX != 'O' AND " & _
                          "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                          "CFSTAT = '" & UCase(wsState.Value) & "'"
ElseIf Len(wsCity.Value) > 0 And Len(wsState.Value) = 0 And Len(wsGender.Value) > 0 And Len(wsAgeL) = 0 And Len(wsAgeU) = 0 Then
    Rem SEARCHES BY CITY AND GENDER
        strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                          "CFSEX = '" & wsGender & "'"
    Rem More Clauses

End If

Alternately, you could eliminate the If clause by using Select Case True.

Select Case True
    Rem SEARCHES BY CITY ONLY
    Case Len(wsCity.Value) > 0, Len(wsState.Value) = 0, Len(wsGender.Value) = 0, Len(wsAgeL) = 0, Len(wsAgeU) = 0
        strSQL = strSQL & "CFCITY= '" & UCase(wsCity.Value) & "' AND CFSEX != 'O'"
    Rem SEARCHES BY CITY AND STATE
    Case Len(wsCity.Value) > 0, Len(wsState.Value) > 0, Len(wsGender.Value) = 0, Len(wsAgeL) = 0, Len(wsAgeU) = 0
        strSQL = strSQL & "CFSEX != 'O' AND " & _
                          "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                          "CFSTAT = '" & UCase(wsState.Value) & "'"
    Rem SEARCHES BY CITY AND GENDER
    Case Len(wsCity.Value) > 0, Len(wsState.Value) = 0, Len(wsGender.Value) > 0, Len(wsAgeL) = 0, Len(wsAgeU) = 0
        strSQL = strSQL & "CFCITY = '" & UCase(wsCity.Value) & "' AND " & _
                          "CFSEX = '" & wsGender & "'"
    Rem More Cases
End Select

I would write a Function in a public module to return the SQL. This function would take all its arguments through parameters and not rely on global variables or worksheet ranges. This will break the dependency to the current workbook structure and make if far easier to test your code.

Function getCFMASTSQL(City As String, State As String, DOB As Single, Gender As String, AgeLower As String, AgeUpper As String) As String
    Const BaseSQL As String = "SELECT cfna1, CFNA2, CFNA3, CFCITY, CFSTAT, LEFT(CFZIP,5) FROM CNCTTP08.JHADAT842.CFMAST CFMAST "

    Dim Wheres As New Collection

    If DOB > 0 Then
        Wheres.Add "cfdob7 = " & DOB
    Else
        Wheres.Add "cfdob7 != 0"
        Wheres.Add "cfdob7 != 1800001"
        Wheres.Add "CFDEAD = 'N'"
    End If

    If Len(AgeLower) > 0 And Len(AgeUpper) > 0 Then
        Wheres.Add "TIMESTAMPDIFF(256, CHAR(TIMESTAMP(CURRENT TIMESTAMP) - TIMESTAMP(DATE(DIGITS(DECIMAL(cfdob7 + 0.090000, 7, 0))), CURRENT TIME))) BETWEEN " & AgeLower & " AND " & AgeUpper
    ElseIf Len(AgeLower) > 0 Then
        Wheres.Add "TIMESTAMPDIFF(256, CHAR(TIMESTAMP(CURRENT TIMESTAMP) - TIMESTAMP(DATE(DIGITS(DECIMAL(cfdob7 + 0.090000, 7, 0))), CURRENT TIME))) >=  " & AgeLower
    ElseIf Len(AgeUpper) > 0 Then
        Wheres.Add "TIMESTAMPDIFF(256, CHAR(TIMESTAMP(CURRENT TIMESTAMP) - TIMESTAMP(DATE(DIGITS(DECIMAL(cfdob7 + 0.090000, 7, 0))), CURRENT TIME))) <=  " & AgeUpper
    End If

    If Len(Gender) > 0 Then
        Wheres.Add "CFSEX = '" & Gender & "'"
    Else
        Wheres.Add "CFSEX != 'O'"
    End If

    If Len(City) > 0 Then Wheres.Add "CFCITY = '" & UCase(City) & "'"
    If Len(State) > 0 Then Wheres.Add "CFSTAT = '" & UCase(State) & "'"

    Dim SQL As String

    If Wheres.Count > 0 Then
        Dim Values() As String
        ReDim Values(1 To Wheres.Count)

        Dim n As Long

        For n = 1 To Wheres.Count
            Values(n) = Wheres(n)
        Next

        SQL = BaseSQL & vbNewLine & "WHERE " & Join(Values, " AND ")
    Else
        SQL = BaseSQL
    End If

    getCFMASTSQL = SQL
End Function

Thank you very much. I knew the code on the Search_Click was horrendous :). I didnt even think of just testing the length within a Select Case statement. I am going to try to implement the function for the SQL as well. I will let you know if i have any additional questions. Thanks again. — Zack E, Commented Nov 12, 2019 at 14:40
I have run through this and implemented the function and it all works excellently. Thank you again for the tips and help with this. It is much appreciated! — Zack E, Commented Nov 12, 2019 at 19:04
My pleasure. I did make some changes to the function since all of those options are optional and also changed it to ByVal — Zack E, Commented Nov 13, 2019 at 13:22

Stack Exchange Network

VBA and SQL to return SQL results to Excel

1 Answer 1

Miscellaneous

Sub Search_Click()

Your Answer

Not the answer you're looking for? Browse other questions tagged
sql
vba
excel
db2
or ask your own question.

Hot Network Questions

VBA and SQL to return SQL results to Excel

1 Answer 1

Miscellaneous

Sub Search_Click()

Your Answer

Sign up or log in

Post as a guest

Not the answer you're looking for? Browse other questions tagged sqlvbaexceldb2 or ask your own question.

Related

Hot Network Questions

Not the answer you're looking for? Browse other questions tagged
sql
vba
excel
db2
or ask your own question.