3
\$\begingroup\$

Before we get started I need to let you know a critical piece of information: Due to permissions within an offsite database I am NOT allowed to create tables even temporary ones within the database that I am getting the data from.

With that being said: All of the code below works as expected, but I would like a review of it because I know that there has to be a more efficient way of writing both the SQL String and the script within VBA.

Steps in the process

  1. Get Data from a SQL Server (please note that I am only getting the first 20 rows as a data set to test, but the final result will be well over 10,000 rows of data)
  2. Excel VBA Macros to grab data with the below SQL String
  3. Save File as a CSV file (This is already completed and working, so no need to address this item.

SQL String

SELECT cfcif# AS "Customer Number",
                 cffna AS "First Name",
                 cfmna AS "Middle Name",
                 COALESCE(
                    NULLIF(cflna,''),cfna1) AS "Last Name",                
                 COALESCE(
                    NULLIF(
                        RTRIM(LTRIM(cfpfa1))|| ' '|| RTRIM(LTRIM(cfpfa2)),''),RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3))) AS "Street Address",
                 COALESCE(
                    NULLIF(cfpfcy,''),cfcity) AS "Street City",
                 COALESCE(
                    NULLIF(cfpfst,''),cfstat) AS "Street State",
                 COALESCE(
                    NULLIF(LEFT(cfpfzc, 5), 0), LEFT(cfzip, 5)) AS "Street Zip",
                 RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3)) AS "Mailing Address",
                 cfcity AS "Mailing City",
                 cfstat AS "Mailing State",
                 LEFT(cfzip, 5) AS "Mailing Zip",
                 NULLIF(cfhpho,0) AS "Home Phone",
                 NULLIF(cfbpho,0) AS "Business Phone",
                 NULLIF(cfssno,0) AS "TIN",
                 (CASE 
                    WHEN cfindi = 'Y' THEN '1'
                    WHEN cfindi = 'N' THEN '2'
                   END)
                  AS "Customer Type",
                 (CASE
                    WHEN cfdob7 = 0 THEN NULL
                    WHEN cfdob7 = 1800001 THEN NULL
                    ELSE cfdob7
                  END) AS "Date of Birth",
                 cfeml1 AS "Email Address"
    FROM bhschlp8.jhadat842.cfmast cfmast
    WHERE cfdead = 'N'
    ORDER BY cfcif#
    FETCH FIRST 20 ROWS ONLY

EXCEL

Private Sub Workbook_Open()
    GetData
End Sub

The below Code is in a Standard Module called ConstVars

Option Explicit
Public Const BRANSONSERVER As String = "bhschlp8.jhadat842.cfmast cfmast"
Public Const CHARLOTTESERVER As String = "cncttp08.jhadat842.cfmast cfmast"
Public Const CONNECTIONERROR As Long = -2147467259
Public Const CONNECTIONSTRING As String = Redacted for public viewing

The below code resides in a Standard Module called CiF

Option Explicit
Sub GetData()

    AddHeaders
    getDBGrabTestRecord (Array(BRANSONSERVER, CHARLOTTESERVER))
    Sheet1.Cells.EntireColumn.AutoFit

End Sub
Private Function getDBGrabTestRecord(arrNames)
    Dim conn As Object
    Set conn = CreateObject("ADODB.Connection")

    Dim rs As Object
    Set rs = CreateObject("ADODB.Recordset")

    Dim nm

    conn.Open CONNECTIONSTRING

    For Each nm In arrNames
        Dim SQL As String

        SQL = getDBGrabSQL(CStr(nm))

        On Error Resume Next
        rs.Open SQL, conn
        Dim okSQL As Boolean
        If Err.Number = 0 Then okSQL = True
        On Error GoTo 0
        If okSQL Then
            If Not rs.EOF Then
                Sheet1.Range("A2").CopyFromRecordset rs
            End If
            Exit For
        End If
    Next nm

End Function
Private Function getCIFDBGrabTestRecord(arrNames)


    Dim SQL As String

    On Error Resume Next

    conn.Open CONNECTIONSTRING

    SQL = getDBGrabSQL(TableName)

    rs.Open SQL, conn

    tDBGrabRecord.ErrNumber = Err.Number

    If Not (rs.BOF And rs.EOF) Then
        rs.MoveFirst
        Sheet1.Range("A2").CopyFromRecordset rs
    End If

    rs.Close
    conn.Close

End Function
Private Function getDBGrabSQL(ByVal TableName As String) As String
    Dim SelectClause As String
    Dim FromClause As String
    Dim WhereClause As String
    Dim OrderClause As String
    Dim FetchClause As String

    SelectClause = GetSelectClause

    FromClause = "FROM " & TableName
    WhereClause = "WHERE cfdead = " & "'" & "N" & "'"
    OrderClause = "ORDER BY cfcif#"
    FetchClause = "FETCH FIRST 20 ROWS ONLY"

    getDBGrabSQL = SelectClause & vbNewLine & FromClause & vbNewLine & WhereClause & vbNewLine & OrderClause & vbNewLine & FetchClause

    Debug.Print getDBGrabSQL

End Function
Private Function GetSelectClause() As String
    Const Delimiter As String = vbNewLine
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    With list
        .Add "SELECT cfcif#,"
        .Add "cffna,"
        .Add "cfmna,"
        .Add "COALESCE("
        .Add "NULLIF(cflna,''),cfna1),"
        .Add "COALESCE("
        .Add "NULLIF("
        .Add "RTRIM(LTRIM(cfpfa1))|| ' '|| RTRIM(LTRIM(cfpfa2)),''),RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3))),"
        .Add "COALESCE("
        .Add "NULLIF(cfpfcy,''),cfcity),"
        .Add "COALESCE("
        .Add "NULLIF(cfpfst,''),cfstat),"
        .Add "COALESCE("
        .Add "NULLIF(LEFT(cfpfzc, 5), 0), LEFT(cfzip, 5)),"
        .Add "RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3)),"
        .Add "cfcity,"
        .Add "cfstat,"
        .Add "LEFT(cfzip, 5),"
        .Add "NULLIF(cfhpho,0),"
        .Add "NULLIF(cfbpho,0),"
        .Add "NULLIF(cfssno,0),"
        .Add "(CASE"
        .Add "WHEN cfindi = 'Y' THEN '1'"
        .Add "WHEN cfindi = 'N' THEN '2'"
        .Add "END),"
        .Add "(CASE"
        .Add "WHEN cfdob7 = 0 THEN NULL"
        .Add "WHEN cfdob7 = 1800001 THEN NULL"
        .Add "ELSE cfdob7"
        .Add "END),"
        .Add "cfeml1"

    End With

    GetSelectClause = Join(list.ToArray, Delimiter)

End Function

The below code resides in a Standard Module called Formatting(I havent given the Sheet or Cells names yet)

Option Explicit
Public Sub AddHeaders()

    Sheet1.Range("A1") = "Customer Number"
    Sheet1.Range("B1") = "First Name"
    Sheet1.Range("C1") = "Middle Name"
    Sheet1.Range("D1") = "Last Name"
    Sheet1.Range("E1") = "Street Address"
    Sheet1.Range("F1") = "Street City"
    Sheet1.Range("G1") = "Street State"
    Sheet1.Range("H1") = "Street Zip"
    Sheet1.Range("I1") = "Mailing Address"
    Sheet1.Range("J1") = "Mailing City"
    Sheet1.Range("K1") = "Mailing State"
    Sheet1.Range("L1") = "Mailing Zip"
    Sheet1.Range("M1") = "Home Phone"
    Sheet1.Range("N1") = "Work Phone"
    Sheet1.Range("O1") = "TIN"
    Sheet1.Range("P1") = "Customer Type"
    Sheet1.Range("Q1") = "Date of Birth"
    Sheet1.Range("R1") = "Email Address"

End Sub
\$\endgroup\$
2
\$\begingroup\$

I can't be much help on the SQL front, but for VBA, I would recommend grouping your Dim statements, as it ultimately reduces compile time (scales well). For instance:

    Dim SelectClause As String
    Dim FromClause As String
    Dim WhereClause As String
    Dim OrderClause As String
    Dim FetchClause As String

Becomes

Dim SelectClause as String, FromClause As String, WhereClause As String, _
    OrderClause As String, FetchClause As String

Also, we can clean up this last Formatting module quite a bit. If this gets any bigger or either your destination range or your destination sheet changes, you'll be glad you refactored:

Public Sub AddHeaders()
Dim mySheet as Worksheet: Set mySheet = Sheet1

Dim labelText as Variant

'I'm putting linebreaks so that they are grouped nicely
labelText = Array("Customer Number", "First Name", "Middle Name", "Last Name", _
    "Street Address", "Street City", "Street State", "Street Zip", _
    "Mailing Address", "Mailing City", "Mailing State", "Mailing Zip", _
    "Home Phone", "Work Phone", _
    "TIN", "Customer Type", "Date of Birth", _
    "Email Address")

For i = 1 to UBound(labelText)
    mySheet.Cells(i, 1).Value = labelText(i)
Next i

End Sub

I'm a big fan of putting Set statements on the same line as Dim statements if it's a widely used variable throughout the procedure, as it is clearly an important statement.

Everything else looks good. Only other thing is that I prefer to put Dim statements outside of the loops if I can. Some people prefer putting them before assigning the variable, to keep track of local variables, but I always feel like it clutters loops. In this instance, you're using it to reset your Boolean so I'd leave it.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thanks. I always go back and forth on grouping Dim statements, and I dont know why i always forget about using Arrays especially since its such a huge part of VBA. I am going to upvote this answer, but I am going to wait a few days to see what others come up with especially with the SQL String. Thanks for taking a look I really appreciate it. \$\endgroup\$ – Zack E Jan 21 at 15:44
  • \$\begingroup\$ I've never used SQL so it would be an injustice to you for me to attempt to review it haha. Arrays are fine and dandy, but if labelText has any possibility of being modified, I'd use a collection. VBA kind of sucks for modifying arrays (no push, pop, shift). \$\endgroup\$ – jclasley Jan 21 at 15:50
  • \$\begingroup\$ labelText wont be modified since its part of a hardcoded dataset on another server. I did make one change to the loop in AddHeaders procedure though; since Arrays are zero based i changed For i = 1 to UBound(labelText) mySheet.Cells(i, 1).Value = labelText(i) Next i to Dim i As Long For i = 0 To UBound(labelText) mySheet.Cells(1, i + 1).Value = labelText(i) Next i \$\endgroup\$ – Zack E Jan 21 at 16:01
  • 1
    \$\begingroup\$ I actually think it's better the way it's written. Dim labelText(0 to 17) as String initializes an 18-string length array with an empty string at each position. This is useful if you know the amount of content you'll have but don't know the contents. Then you can go in adding them as you see fit. However, when we already know exactly what will be in the array, it's much easier to initialize the array with its values rather than initializing an empty array to be filled in later. \$\endgroup\$ – jclasley Jan 21 at 16:17
  • 1
    \$\begingroup\$ @jclasley Declaring variables separately has a negligible impact at compile time. Grouping them as you have suggested actually clutters code. What should be done is to declare variables close to where they are being used, as it greatly improves readability. That being said, no matter what, one should never declare a variable in a loop unless there is no alternative. Such would be the the case when using ReDim Preserve for increasing the size of a dynamic array, but doing so is not recommended as you will definitely take a performance hit. \$\endgroup\$ – rickmanalexander Jan 25 at 21:28

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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