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 amNOT 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()    GetDataEnd Sub

The below Code is in a Standard Module called ConstVars

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

The below code resides in a Standard Module called CiF

Option ExplicitSub GetData()    AddHeaders    getDBGrabTestRecord (Array(BRANSONSERVER, CHARLOTTESERVER))    Sheet1.Cells.EntireColumn.AutoFitEnd SubPrivate 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 nmEnd FunctionPrivate 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.CloseEnd FunctionPrivate 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 getDBGrabSQLEnd FunctionPrivate 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 ExplicitPublic 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
askedJan 20, 2020 at 21:56
Zack E's user avatar
\$\endgroup\$

1 Answer1

2
\$\begingroup\$

I can't be much help on the SQL front, but for VBA, I would recommend grouping yourDim 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 = Sheet1Dim labelText as Variant'I'm putting linebreaks so that they are grouped nicelylabelText = 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 iEnd Sub

I'm a big fan of puttingSet statements on the same line asDim 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 putDim 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.

answeredJan 21, 2020 at 15:33
jclasley's user avatar
\$\endgroup\$
8
  • \$\begingroup\$Thanks. I always go back and forth on groupingDim statements, and I dont know why i always forget about usingArrays 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\$CommentedJan 21, 2020 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 iflabelText has any possibility of being modified, I'd use a collection. VBA kind of sucks for modifying arrays (no push, pop, shift).\$\endgroup\$CommentedJan 21, 2020 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 inAddHeaders procedure though; sinceArrays are zero based i changedFor i = 1 to UBound(labelText) mySheet.Cells(i, 1).Value = labelText(i) Next i toDim i As Long For i = 0 To UBound(labelText) mySheet.Cells(1, i + 1).Value = labelText(i) Next i\$\endgroup\$CommentedJan 21, 2020 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\$CommentedJan 21, 2020 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 usingReDim Preserve for increasing the size of a dynamic array, but doing so is not recommended as you will definitely take a performance hit.\$\endgroup\$CommentedJan 25, 2020 at 21:28

You mustlog in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.