3
\$\begingroup\$

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
asked Nov 11, 2019 at 18:50
\$\endgroup\$
10
  • 1
    \$\begingroup\$ 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! \$\endgroup\$ Commented Nov 11, 2019 at 18:58
  • 1
    \$\begingroup\$ @MathieuGuindon That is correct this code is all in the UserForm module. \$\endgroup\$ Commented Nov 11, 2019 at 19:15
  • 1
    \$\begingroup\$ @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 :( \$\endgroup\$ Commented Nov 11, 2019 at 19:21
  • 1
    \$\begingroup\$ Ah, yes, requiring admin rights to fight evil, I know that problem. No problem, Mat is a walking, talking rubberduck. \$\endgroup\$ Commented Nov 11, 2019 at 19:26
  • 1
    \$\begingroup\$ You don't need to edit your code further (at least in this question). The problems with it are perfectly reviewable :-) \$\endgroup\$ Commented Nov 11, 2019 at 19:28

1 Answer 1

3
\$\begingroup\$

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

Immediate Window

Greedo
2,6252 gold badges15 silver badges36 bronze badges
answered Nov 12, 2019 at 13:27
\$\endgroup\$
3
  • \$\begingroup\$ 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. \$\endgroup\$ Commented Nov 12, 2019 at 14:40
  • \$\begingroup\$ 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! \$\endgroup\$ Commented Nov 12, 2019 at 19:04
  • \$\begingroup\$ My pleasure. I did make some changes to the function since all of those options are optional and also changed it to ByVal \$\endgroup\$ Commented Nov 13, 2019 at 13:22

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.