1
\$\begingroup\$

With thanks to @BrandonBarney for his encouragement, here is a program I wrote to automate massive data pulls for my team.

Warning: I included all the methods in case anyone wanted to see all of them, but I strongly recommend skimming or just looking at a few.

This program:

  1. Breaks large lists of research items into small chunks and queries from the database repeatedly
  2. Runs multiple queries on the same research items
  3. Makes new sheets when results fill more than one Excel sheet
  4. Checks for research items that are missing from the results

Main Procedure

Sub M1AutomatedQueryer()

Dim lngItemsSoFar As Long


    Dim arrDatabaseTable As Variant
    arrDatabaseTable = LoadDatabaseTable

    InitialSetup

    Dim rngQueryCells As Range
    Set rngQueryCells = DeterminerngQueryCells
    Dim rngQueryCell As Range
    For Each rngQueryCell In rngQueryCells
        PreventInitialErrors rngQueryCell.Row
    Next rngQueryCell

    '--- Multiple Queries ---
    For Each rngQueryCell In rngQueryCells
        'See if query is active
        If rngQueryCell.Value = "Yes" Then


            WriteQueriesSheetMetaParameters rngQueryCell.Row
            WriteDatabaseTableMetaParameters rngQueryCell.Row


            lngItemsSoFar = 0


            SetupProgressBar "Querying Research Items..."


LoopAgain:
            '--- Prepare Query ---
            Dim strResearchItemsToQueryThisRun As String
            If QueryMetaParameters.strResearchClause <> "N/A" Then strResearchItemsToQueryThisRun = PrepareResearchItemsToQueryThisRun(lngItemsSoFar)
            Dim strFormattedQuery As String
            strFormattedQuery = FormatQuery(QueryMetaParameters.strQuery, strResearchItemsToQueryThisRun, QueryMetaParameters.strResearchClause)
            CreateQueryDebugLog strFormattedQuery

            '--- Connect and Execute Query ---
            Dim cnn As ADODB.Connection
            Set cnn = OpenConnection(QueryMetaParameters.strSQLApp, QueryMetaParameters.strDatabase, QueryMetaParameters.strUsername, QueryMetaParameters.strPassword, QueryMetaParameters.strDataSource)

            Dim cmd As ADODB.Command
            Set cmd = PrepareQueryCommand(cnn, strFormattedQuery)

            Dim rst As ADODB.Recordset
            Set rst = New ADODB.Recordset
            rst.Open cmd


            SearchForRecordsetsAndCopyToSheet cnn, rst, QueryMetaParameters.strQueryName


            'Repeat with next group of research items
            With ResearchItems
                Dim lngTotalResearchItems As Long
                lngTotalResearchItems = Application.CountA(.Columns(1))
                If lngTotalResearchItems - lngItemsSoFar > QueryMetaParameters.intItemsAtOnce Then
                    lngItemsSoFar = lngItemsSoFar + QueryMetaParameters.intItemsAtOnce
                    UpdateProgressBar "Querying Research Items...", lngItemsSoFar
                    GoTo LoopAgain
                End If
            End With

        End If
    Next rngQueryCell


    NoResultsFoundCheck
    MissingResultsCheck rngQueryCells


    MsgBox "All Done."


    Unload ProgressBar
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.StatusBar = False

End Sub

Sub Methods from M000TopLevel Module

Sub Cancel()

    Dim UForm1 As UserForm
    For Each UForm1 In VBA.UserForms
        Unload UForm1
    Next UForm1

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.StatusBar = False
    End

End Sub

Sub Methods from M010General Module

Public QueryMetaParameters As classQueryMetaParameters


Function LoadDatabaseTable() As Variant

    With DatabaseTable
        Dim lngLastRow As Long
        lngLastRow = Application.CountA(.Columns(2))
        Dim arrRangeToArray() As Variant
        arrRangeToArray = .Range(.Cells(2, 1), .Cells(lngLastRow, 6)).Value
    End With

    LoadDatabaseTable = arrRangeToArray

End Function


Sub InitialSetup()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    'Delete old results
    If ThisWorkbook.Sheets.Count > 3 Then
        If MsgBox("All previous results will be deleted. Press yes if it is okay to proceed, and no to stop everything.", vbYesNo) = vbNo Then Cancel
        Dim Sheet1 As Worksheet
        For Each Sheet1 In ThisWorkbook.Sheets
            Select Case Sheet1.Name
                Case Queries.Name, ResearchItems.Name, DatabaseTable.Name
                Case Else
                    Application.DisplayAlerts = False
                    Sheet1.Delete
                    Application.DisplayAlerts = True
            End Select
        Next Sheet1
    End If

    'Deduplicate research items to be queried
    With ResearchItems
        Dim lngLastResearchItemsRow As Long
        lngLastResearchItemsRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Dim rngResearchItems As Range
        Set rngResearchItems = .Range(.Cells(1, 1), .Cells(lngLastResearchItemsRow, 1))
        rngResearchItems.RemoveDuplicates Columns:=1, Header:=xlNo
    End With

    Set QueryMetaParameters = New classQueryMetaParameters

End Sub


Function DeterminerngQueryCells() As Range

    With Queries
        Dim lngLastQueriesRow As Long
        lngLastQueriesRow = Application.CountA(.Columns(1))
        Dim lngActiveColumn As Long
        If .Rows(1).Find(What:="Active: Yes/No", Lookat:=xlWhole) Is Nothing Then
            MsgBox "Can't find Active: Yes/No column on Queries sheet."
            Cancel
        Else
            lngActiveColumn = .Rows(1).Find(What:="Active: Yes/No", Lookat:=xlWhole).Column
        End If
        Dim rngQueryCells As Range
        Set rngQueryCells = .Range(.Cells(2, lngActiveColumn), .Cells(lngLastQueriesRow, lngActiveColumn))
    End With

    Set DeterminerngQueryCells = rngQueryCells

End Function


Sub PreventInitialErrors(ByVal lngQueryCellRow As Long)

    WriteQueriesSheetMetaParameters lngQueryCellRow
    DetectQueriesSheetMetaParameterErrors lngQueryCellRow

    WriteDatabaseTableMetaParameters lngQueryCellRow
    DetectDatabaseTableMetaParameterErrors lngQueryCellRow

End Sub


Sub NonNegativeIntegerCheckAndFix(ByRef QueryMetaParameterCell As Range, strQueryName As String, SheetName As String, ColumnName As String)

    'If the user didn't put anything
    If QueryMetaParameterCell.Value = vbNullString Then
        'Silently change to 0
        If ColumnName = "Research Item Column #" Then
            QueryMetaParameterCell.Value = 0
        End If
        'Can't accept 0, error out
        If ColumnName = "Items at Once" Then
            If SheetName = "Queries" Then
                MsgBox "Please fill the " & ColumnName & " column for the " & strQueryName & " query on the " & SheetName & " sheet with a positive integer."
                Cancel
            Else
                MsgBox "Please fill the " & ColumnName & " column for row " & QueryMetaParameterCell.Row & " on the " & SheetName & " sheet with a positive integer."
                Cancel
            End If
        End If
    End If
    'If the user put a non-numeric, non-integer, or negative value, error out
    If IsNumeric(QueryMetaParameterCell.Value) = False Or Int(QueryMetaParameterCell.Value) <> QueryMetaParameterCell.Value Or QueryMetaParameterCell.Value < 0 Then
        If SheetName = "Database Table" Then
            MsgBox "Please fill the " & ColumnName & " column for row " & QueryMetaParameterCell.Row & " on the " & SheetName & " sheet with a non-negative integer."
            Cancel
        Else
            MsgBox "Please fill the " & ColumnName & " column for the " & strQueryName & " query on the " & SheetName & " sheet with a non-negative integer."
            Cancel
        End If
    End If

End Sub


Sub NoResultsFoundCheck()

    If Not (ThisWorkbook.Sheets.Count > 3) Then
        MsgBox "No results found for any query."
        Cancel
    End If

End Sub


Sub MissingResultsCheck(ByVal rngQueryCells As Range)

    Dim Loop1 As Long


    'Check for missing research items in results if Research Item Column specified
    Dim rngQueryCell As Range
    For Each rngQueryCell In rngQueryCells
        'See if query is active
        If rngQueryCell.Value = "Yes" Then
            WriteQueriesSheetMetaParameters rngQueryCell.Row
            WriteDatabaseTableMetaParameters rngQueryCell.Row
            If QueryMetaParameters.intResearchItemColumn <> 0 And ResultsSheetExistsForThisQuery = True Then
                If MissingItemsSheetExistsForThisQuery = False Then
                    Dim CurrentMissingItemsSheet As Worksheet
                    Set CurrentMissingItemsSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                    CurrentMissingItemsSheet.Name = "Missing Items - " & Left(SanitizeSheetNameCandidate(QueryMetaParameters.strQueryName), 15)
                Else
                    Set CurrentMissingItemsSheet = ThisWorkbook.Sheets("Missing Items - " & Left(QueryMetaParameters.strQueryName, 15))
                End If

                With ResearchItems
                    Dim lngResearchItemsCount As Long
                    lngResearchItemsCount = Application.CountA(.Columns(1))
                    Dim rngResearchItems As Range
                    Set rngResearchItems = .Range(.Cells(1, 1), .Cells(lngResearchItemsCount, 1))
                    'Protect against arrResearchItemsRequested breaking if only one research item is present
                    Dim arrResearchItemsRequested() As Variant
                    If rngResearchItems.Cells.Count = 1 Then
                        ReDim arrResearchItemsRequested(1 To 1, 1 To 1)
                        arrResearchItemsRequested(1, 1) = rngResearchItems.Value
                    Else
                        arrResearchItemsRequested = rngResearchItems.Value
                    End If
                End With

                UpdateProgressBar "Looking for Missing Research Items in " & QueryMetaParameters.strQueryName & " Results ...", ThisProgressBar.Denominator

                For Each Sheet1 In ThisWorkbook.Sheets
                    If InStr(1, Sheet1.Name, Left(SanitizeSheetNameCandidate(QueryMetaParameters.strQueryName), 18) & " Results (", vbTextCompare) > 0 Then
                        With Sheet1
                            Dim lngLastResearchItemRow As Long
                            'Using the end up method on a full sheet will go to the top
                            If .Cells(.Rows.Count, QueryMetaParameters.intResearchItemColumn).Value <> vbNullString Then
                                lngLastResearchItemRow = 1048576
                            Else
                                lngLastResearchItemRow = .Cells(.Rows.Count, QueryMetaParameters.intResearchItemColumn).End(xlUp).Row
                            End If
                            Dim arrResearchItemsInResults() As Variant
                            arrResearchItemsInResults() = .Range(.Cells(1, QueryMetaParameters.intResearchItemColumn), .Cells(lngLastResearchItemRow, QueryMetaParameters.intResearchItemColumn)).Value
                            Dim dictResearchItemsInResults As Scripting.Dictionary
                            Set dictResearchItemsInResults = Nothing
                            Set dictResearchItemsInResults = New Scripting.Dictionary
                            For Loop1 = LBound(arrResearchItemsInResults) To UBound(arrResearchItemsInResults)
                                If dictResearchItemsInResults.Exists(arrResearchItemsInResults(Loop1, 1)) = False Then dictResearchItemsInResults.Add Key:=arrResearchItemsInResults(Loop1, 1), Item:=vbNullString
                            Next Loop1
                            For Loop1 = LBound(arrResearchItemsRequested) To UBound(arrResearchItemsRequested)
                                If dictResearchItemsInResults.Exists(arrResearchItemsRequested(Loop1, 1)) Then arrResearchItemsRequested(Loop1, 1) = Empty
                            Next Loop1
                        End With
                    End If
                Next Sheet1

                CurrentMissingItemsSheet.Cells(1, 1).Resize(UBound(arrResearchItemsRequested), 1).Value = arrResearchItemsRequested

                If Application.CountA(CurrentMissingItemsSheet.Columns(1)) = 0 Then
                    Application.DisplayAlerts = False
                    CurrentMissingItemsSheet.Delete
                    Application.DisplayAlerts = True
                Else
                    CurrentMissingItemsSheet.Range(CurrentMissingItemsSheet.Cells(1, 1), CurrentMissingItemsSheet.Cells(CurrentMissingItemsSheet.Range("A" & CurrentMissingItemsSheet.Rows.Count).End(xlUp).Row, 1)).RemoveDuplicates Columns:=1
                End If
            End If
        End If
NextQuery:
    Next rngQueryCell

End Sub


Function SanitizeSheetNameCandidate(ByVal strSheetNameCandidate As String) As String

    strSheetNameCandidate = Replace(strSheetNameCandidate, "\", "", , , vbTextCompare)
    strSheetNameCandidate = Replace(strSheetNameCandidate, "/", "", , , vbTextCompare)
    strSheetNameCandidate = Replace(strSheetNameCandidate, "*", "", , , vbTextCompare)
    strSheetNameCandidate = Replace(strSheetNameCandidate, "[", "", , , vbTextCompare)
    strSheetNameCandidate = Replace(strSheetNameCandidate, "]", "", , , vbTextCompare)
    strSheetNameCandidate = Replace(strSheetNameCandidate, ":", "", , , vbTextCompare)
    strSheetNameCandidate = Replace(strSheetNameCandidate, "?", "", , , vbTextCompare)

    SanitizeSheetNameCandidate = strSheetNameCandidate

End Function

Sub Methods from M011QueryPreparation Module

Sub WriteQueriesSheetMetaParameters(ByVal lngQueryCellRow As Long)

    With Queries
        'Query Name
        Dim lngQueryNameColumn As Long
        lngQueryNameColumn = .Rows(1).Find(What:="Query Name", Lookat:=xlWhole).Column
        QueryMetaParameters.strQueryName = .Cells(lngQueryCellRow, lngQueryNameColumn).Value

        'Active: Yes/No
        Dim lngActiveColumn As Long
        lngActiveColumn = .Rows(1).Find(What:="Active: Yes/No").Column
        'Convert input to boolean
        If InStr(1, .Cells(lngQueryCellRow, lngActiveColumn).Value, "Yes", vbTextCompare) = 0 And InStr(1, .Cells(lngQueryCellRow, lngActiveColumn).Value, "No", vbTextCompare) = 0 Then
            Dim strFixActiveColumn As String
            strFixActiveColumn = MsgBox("Cannot determine whether the " & .Cells(lngQueryCellRow, lngQueryNameColumn).Value & " query is active. Should this query be active?", vbYesNo, "Is the " & .Cells(lngQueryCellRow, lngQueryNameColumn).Value & " query active?")
            If strFixActiveColumn = vbYes Then .Cells(lngQueryCellRow, lngActiveColumn).Value = "Yes" Else .Cells(lngQueryCellRow, lngActiveColumn).Value = "No"
        End If
        If .Cells(lngQueryCellRow, lngActiveColumn).Value = "Yes" Then
            QueryMetaParameters.boolActive = True
        Else
            QueryMetaParameters.boolActive = False
        End If

        'Database
        Dim lngDatabaseColumn As Long
        lngDatabaseColumn = .Rows(1).Find(What:="Database", Lookat:=xlWhole).Column
        QueryMetaParameters.strDatabase = .Cells(lngQueryCellRow, lngDatabaseColumn).Value

        'Query
        Dim lngQueryColumn As Long
        lngQueryColumn = .Rows(1).Find(What:="Query without Comments", Lookat:=xlWhole).Column
        QueryMetaParameters.strQuery = .Cells(lngQueryCellRow, lngQueryColumn).Value

        'Research Item Clause
        Dim lngResearchClauseColumn As Long
        lngResearchClauseColumn = .Rows(1).Find(What:="Research Item Clause", Lookat:=xlWhole).Column
        QueryMetaParameters.strResearchClause = .Cells(lngQueryCellRow, lngResearchClauseColumn).Value

        'Research Item Column #
        Dim lngResearchItemColumnNumberColumn As Long
        lngResearchItemColumnNumberColumn = .Rows(1).Find(What:="Research Item Column #", Lookat:=xlWhole).Column


        NonNegativeIntegerCheckAndFix .Cells(lngQueryCellRow, lngResearchItemColumnNumberColumn), QueryMetaParameters.strQueryName, .Name, .Cells(1, lngResearchItemColumnNumberColumn).Value


        QueryMetaParameters.intResearchItemColumn = .Cells(lngQueryCellRow, lngResearchItemColumnNumberColumn).Value
    End With

End Sub


Sub DetectQueriesSheetMetaParameterErrors(ByVal lngQueryCellRow As Long)

    With Queries
        '--- Database ---
        'Empty despite being mandatory
        If QueryMetaParameters.strDatabase = "" Then
            MsgBox "Please add a database to the " & QueryMetaParameters.strQueryName & " query."
            Cancel
        End If

        'Unrecognized value
        With DatabaseTable
            Dim lngDatabaseColumn As Long
            lngDatabaseColumn = .Rows(1).Find(What:="Database", Lookat:=xlWhole).Column
            Dim rngDatabaseMatch As Range
            Set rngDatabaseMatch = .Range(.Cells(2, lngDatabaseColumn), .Cells(Application.CountA(.Columns(lngDatabaseColumn)), lngDatabaseColumn)).Find(What:=QueryMetaParameters.strDatabase, Lookat:=xlWhole)
            If rngDatabaseMatch Is Nothing Then
                MsgBox "The Database listed for the " & QueryMetaParameters.strQueryName & " query does not appear in the Database column on the Database Table sheet. Please correct the Database on the Queries sheet or add the appropriate information to the Database Table sheet."
                Cancel
            Else
                Dim lngDatabaseTableRow As Long
                lngDatabaseTableRow = rngDatabaseMatch.Row
            End If
        End With

        '--- Query without Comments ---
        'Empty despite being mandatory
        If QueryMetaParameters.strQuery = "" Then
            MsgBox "Please add code to the Query without Comments column for the " & QueryMetaParameters.strQueryName & " query."
            Cancel
        End If
        'Comments present in query
        If InStr(1, QueryMetaParameters.strQuery, "--", vbTextCompare) > 0 Then
            MsgBox "Please remove all comments (" & "--" & ") from the " & QueryMetaParameters.strQueryName & " query."
            Cancel
        End If

        '--- Research Item Clause ---
        Dim lngResearchClauseColumn As Long
        lngResearchClauseColumn = .Rows(1).Find(What:="Research Item Clause", Lookat:=xlWhole).Column

        'Silent failures
        'User didn't put anything (Change it to N/A (Ignore the Research items sheet))
        If QueryMetaParameters.strResearchClause = vbNullString Then
            QueryMetaParameters.strResearchClause = "N/A"
            .Cells(lngQueryCellRow, lngResearchClauseColumn).Value = "N/A"
        End If
        'Closes with a space
        If Right(QueryMetaParameters.strResearchClause, 1) = " " Then
            Do Until Right(QueryMetaParameters.strResearchClause, 1) <> " "
                QueryMetaParameters.strResearchClause = Left(QueryMetaParameters.strResearchClause, Len(QueryMetaParameters.strResearchClause) - 1)
            Loop
            .Cells(lngQueryCellRow, lngResearchClauseColumn).Value = QueryMetaParameters.strResearchClause
        End If

        'Noisy failures
        'Closes with two ))
        If Right(QueryMetaParameters.strResearchClause, 2) = "))" Then
            Do Until Right(QueryMetaParameters.strResearchClause, 2) <> "))"
                .Cells(lngQueryCellRow, lngResearchClauseColumn).Value = Left(.Cells(lngQueryCellRow, lngResearchClauseColumn).Value, Len(.Cells(lngQueryCellRow, lngResearchClauseColumn)) - 1)
                QueryMetaParameters.strResearchClause = .Cells(lngQueryCellRow, lngResearchClauseColumn).Value
            Loop
        End If
        'Present on Queries sheet but not present in query
        If InStr(1, QueryMetaParameters.strQuery, QueryMetaParameters.strResearchClause, vbTextCompare) = 0 And QueryMetaParameters.strResearchClause <> "N/A" Then
            MsgBox "Research item clause for the " & QueryMetaParameters.strQueryName & " query is not present in the actual query code. Please match the research item clause to the query."
            Cancel
        End If
        'Research item clause closes with non-)
        If Right(QueryMetaParameters.strResearchClause, 1) <> ")" And QueryMetaParameters.strResearchClause <> "N/A" Then
            MsgBox "Please end your Research Item Clause for the " & QueryMetaParameters.strQueryName & " query with a )."
            Cancel
        End If
    End With

End Sub


Sub WriteDatabaseTableMetaParameters(ByVal lngQueryCellRow As Long)

    With DatabaseTable
        'Determine matching row on Database Table given Database from Queries sheet
        Dim lngDatabaseColumn As Long
        lngDatabaseColumn = .Rows(1).Find(What:="Database", Lookat:=xlWhole).Column
        Dim lngDatabaseTableRow As Long
        lngDatabaseTableRow = .Range(.Cells(2, lngDatabaseColumn), .Cells(Application.CountA(.Columns(lngDatabaseColumn)), lngDatabaseColumn)).Find(What:=QueryMetaParameters.strDatabase, Lookat:=xlWhole).Row

        'SQL App
        Dim lngSQLAppColumn As Long
        lngSQLAppColumn = .Rows(1).Find(What:="SQL App", Lookat:=xlWhole).Column
        QueryMetaParameters.strSQLApp = .Cells(lngDatabaseTableRow, lngSQLAppColumn).Value

        'Data Source
        Dim lngDataSourceColumn As Long
        lngDataSourceColumn = .Rows(1).Find(What:="Data Source", Lookat:=xlWhole).Column
        QueryMetaParameters.strDataSource = .Cells(lngDatabaseTableRow, lngDataSourceColumn).Value

        'Username
        Dim lngUsernameColumn As Long
        lngUsernameColumn = .Rows(1).Find(What:="Username", Lookat:=xlWhole).Column
        QueryMetaParameters.strUsername = .Cells(lngDatabaseTableRow, lngUsernameColumn).Value

        'Password
        Dim lngPasswordColumn As Long
        lngPasswordColumn = .Rows(1).Find(What:="Password", Lookat:=xlWhole).Column
        QueryMetaParameters.strPassword = .Cells(lngDatabaseTableRow, lngPasswordColumn).Value

        'Items at Once
        Dim intItemsAtOnceColumn As Long
        intItemsAtOnceColumn = .Rows(1).Find(What:="Items at Once", Lookat:=xlWhole).Column


        NonNegativeIntegerCheckAndFix .Cells(lngDatabaseTableRow, intItemsAtOnceColumn), QueryMetaParameters.strQueryName, .Name, .Cells(1, intItemsAtOnceColumn).Value


        QueryMetaParameters.intItemsAtOnce = .Cells(lngDatabaseTableRow, intItemsAtOnceColumn).Value
    End With

End Sub


Sub DetectDatabaseTableMetaParameterErrors(ByVal lngQueryCellRow As Long)



End Sub


Function PrepareResearchItemsToQueryThisRun(ByVal lngItemsSoFar As Long) As String

    With ResearchItems
        Dim lngNumberOfResearchItems As Long
        lngNumberOfResearchItems = Application.CountA(.Columns(1))
        'Research Items missing
        If lngNumberOfResearchItems = 0 Then
            MsgBox "The " & QueryMetaParameters.strQueryName & " query has a Research Items Clause, but there are no items present on the Research Items sheet."
            Cancel
        End If
        'Limit number of research items to be queried to QueryMetaParameters.intItemsAtOnce
        If lngNumberOfResearchItems - lngItemsSoFar > QueryMetaParameters.intItemsAtOnce Then lngNumberOfResearchItems = lngItemsSoFar + QueryMetaParameters.intItemsAtOnce
        'Get the next batch and format them properly
        Dim strResearchItemsToQueryThisRun As String
        strResearchItemsToQueryThisRun = vbNullString
        'Protect against RangeToArray breaking if only one research item is present
        Dim arrRangeToArray() As Variant
        If .Range(.Cells(lngItemsSoFar + 1, 1), .Cells(lngNumberOfResearchItems, 1)).Cells.Count = 1 Then
            ReDim arrRangeToArray(1 To 1, 1 To 1)
            arrRangeToArray(1, 1) = .Range(.Cells(lngItemsSoFar + 1, 1), .Cells(lngNumberOfResearchItems, 1)).Value
        Else
            arrRangeToArray() = .Range(.Cells(lngItemsSoFar + 1, 1), .Cells(lngNumberOfResearchItems, 1)).Value
        End If
        Dim arrRangeToArray1D() As Variant
        ReDim arrRangeToArray1D(UBound(arrRangeToArray, 1) - 1) 'because 1D array is 0-based
        Dim Loop1 As Long
        For Loop1 = LBound(arrRangeToArray, 1) To UBound(arrRangeToArray, 1)
            arrRangeToArray1D(Loop1 - 1) = arrRangeToArray(Loop1, 1)
        Next Loop1
        'Like any ()
        If InStr(1, QueryMetaParameters.strResearchClause, "like any", vbTextCompare) > 0 Then strResearchItemsToQueryThisRun = "'%" & Join(arrRangeToArray1D, "%','%") & "%'"
        'In ()
        If InStr(1, QueryMetaParameters.strResearchClause, "in (", vbTextCompare) > 0 Then strResearchItemsToQueryThisRun = "'" & Join(arrRangeToArray1D, "','") & "'"
        'Insert into
        'If InStr(1, QueryMetaParameters.strResearchClause, "insert into", vbTextCompare) > 0 Then strResearchItemsToQueryThisRun = strResearchItemsToQueryThisRun & Left(QueryMetaParameters.strResearchClause, Len(QueryMetaParameters.strResearchClause) - 1) & "'" & Cell1.Value & "');"
        If InStr(1, QueryMetaParameters.strResearchClause, "insert into", vbTextCompare) > 0 Then strResearchItemsToQueryThisRun = Left(QueryMetaParameters.strResearchClause, Len(QueryMetaParameters.strResearchClause) - 1) & "'" & Join(arrRangeToArray1D, "'); " & Left(QueryMetaParameters.strResearchClause, Len(QueryMetaParameters.strResearchClause) - 1) & "'") & "');"

        PrepareResearchItemsToQueryThisRun = strResearchItemsToQueryThisRun
    End With

End Function


Function FormatQuery(ByVal strQuery As String, ByVal strResearchItemsToQueryThisRun As String, ByVal strResearchClause As String)

    strQuery = Replace(strQuery, vbCrLf, " ", vbTextCompare)
    strQuery = Replace(strQuery, vbLf, " ", vbTextCompare)
    strQuery = Replace(strQuery, vbCr, " ", vbTextCompare)

    'Assumes INSERT INTO MyTable (OptionalColumnName) VALUES ('ResearchItem1'), ('ResearchItem2') is not valid
    If InStr(1, strResearchItemsToQueryThisRun, "insert into", vbTextCompare) = 0 Then
        'All non-'Insert into' queries put the strListofClaims in between parentheses of strResearchClause
        strQuery = Replace(strQuery, strResearchClause, Left(strResearchClause, Len(strResearchClause) - 1) & strResearchItemsToQueryThisRun & ")", , , vbTextCompare)
    Else
        ''Insert into' queries had to have the research clause included in strListofClaims already
        strQuery = Replace(strQuery, strResearchClause, strResearchItemsToQueryThisRun, , , vbTextCompare)
    End If

    FormatQuery = strQuery

End Function

Sub Methods from M012MissingResultsCheck Module

Function ResultsSheetExistsForThisQuery() As Boolean

    Dim boolResultsSheetExistsForThisQuery As Boolean
    boolResultsSheetExistsForThisQuery = False
    Dim Sheet1 As Worksheet
    For Each Sheet1 In ThisWorkbook.Sheets
        If InStr(1, Sheet1.Name, Left(SanitizeSheetNameCandidate(QueryMetaParameters.strQueryName), 18) & " Results (", vbTextCompare) > 0 Then boolResultsSheetExistsForThisQuery = True
    Next Sheet1

    ResultsSheetExistsForThisQuery = boolResultsSheetExistsForThisQuery

End Function


Function MissingItemsSheetExistsForThisQuery() As Boolean

    Dim boolMissingItemsSheetExistsForThisQuery As Boolean
    boolMissingItemsSheetExistsForThisQuery = False
    For Each Sheet1 In ThisWorkbook.Sheets
        If Sheet1.Name = "Missing Items - " & Left(SanitizeSheetNameCandidate(QueryMetaParameters.strQueryName), 15) Then boolMissingItemsSheetExistsForThisQuery = True
    Next Sheet1

    MissingItemsSheetExistsForThisQuery = boolMissingItemsSheetExistsForThisQuery

End Function

Sub Methods from M020QueryProcess Module

Sub CreateQueryDebugLog(ByVal strQuery As String)

    Dim intSystemFileNumber As Integer
    intSystemFileNumber = FreeFile()
    Open "\\##########\strQuery.txt" For Output As #intSystemFileNumber
    Print #intSystemFileNumber, strQuery
    Close #intSystemFileNumber

End Sub


Function OpenConnection(ByVal strSQLApp As String, ByVal strDatabase As String, ByVal strUsername As String, ByVal strPassword As String, ByVal strDataSource As String) As ADODB.Connection

    Dim cnn As ADODB.Connection
    Set cnn = New ADODB.Connection
    cnn.ConnectionTimeout = 0
    Dim strConn As String
    (((strConn set here)))
    cnn.Open strConn

    Set OpenConnection = cnn

End Function


Function PrepareQueryCommand(ByVal cnn As ADODB.Connection, strFormattedQuery As String) As ADODB.Command

    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = cnn
    cmd.CommandTimeout = 0
    cmd.CommandText = strFormattedQuery

    Set PrepareQueryCommand = cmd

End Function


Sub SearchForRecordsetsAndCopyToSheet(ByVal cnn As ADODB.Connection, ByVal rst As ADODB.Recordset, ByVal strQueryName As String)

    Do Until rst Is Nothing
        If (rst.State And adStateOpen) Then
            'Copy results
            If Not rst.EOF Then
                Dim boolResultsSheetExistsForThisQuery As Boolean
                boolResultsSheetExistsForThisQuery = False
                Dim CurrentResultsSheet As Worksheet
                For Each CurrentResultsSheet In ThisWorkbook.Sheets
                    If InStr(1, CurrentResultsSheet.Name, Left(SanitizeSheetNameCandidate(QueryMetaParameters.strQueryName), 18) & " Results (", vbTextCompare) > 0 Then
                        boolResultsSheetExistsForThisQuery = True
                        Exit For
                    End If
                Next CurrentResultsSheet
                If boolResultsSheetExistsForThisQuery = False Then
                    Set CurrentResultsSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                    CurrentResultsSheet.Name = Left(SanitizeSheetNameCandidate(QueryMetaParameters.strQueryName), 18) & " Results (1)"

                    CopyRecordsetToSheet CurrentResultsSheet, rst
                Else
                    'If there is a results sheet already but it's full, make a new one
                    If ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Rows.Count = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Cells.Find(What:="*", After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Then
                        Set CurrentResultsSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                        'Increment the number on the previous sheet by 1
                        CurrentResultsSheet.Name = Left(SanitizeSheetNameCandidate(QueryMetaParameters.strQueryName), 18) & " Results (" & Mid(ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1).Name, InStrRev(ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1).Name, "(", , vbTextCompare) + 1, InStrRev(ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1).Name, ")", , vbTextCompare) - (InStrRev(ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1).Name, "(", , vbTextCompare) + 1)) + 1 & ")"

                        CopyRecordsetToSheet CurrentResultsSheet, rst

                    Else
                        Set CurrentResultsSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                        With CurrentResultsSheet
                            Dim lngUnavailableRows As Long
                            lngUnavailableRows = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                            .Cells(lngUnavailableRows + 1, 1).CopyFromRecordset rst, .Rows.Count - lngUnavailableRows
                        End With
                    End If
                End If
            Else
                MsgBox "No " & strQueryName & " records returned."
            End If

            If ########## Then
                Set rst = rst.NextRecordset
            Else
                Exit Do
            End If
        Else
            If ########## Then
                Set rst = rst.NextRecordset
            Else
                Exit Do
            End If
        End If
    Loop
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing

End Sub

Sub Methods from M021QueryProcess Module

Sub CopyRecordsetToSheet(ByVal CurrentResultsSheet As Worksheet, ByVal rst As Recordset)

    With CurrentResultsSheet
        Dim Range1 As Range
        Set Range1 = .Range(.Cells(1, 1), .Cells(1, rst.Fields.Count))
        Dim Cell1 As Range
        For Each Cell1 In Range1
            Cell1.Value = rst.Fields(Cell1.Column - 1).Name
            Cell1.Font.Bold = True
        Next Cell1
        Dim lngUnavailableRows As Long
        lngUnavailableRows = Application.CountA(.Columns(1))
        .Cells(lngUnavailableRows + 1, 1).CopyFromRecordset rst, .Rows.Count - lngUnavailableRows
    End With

End Sub

Sub Methods from M200ProgressBar Module

Public ThisProgressBar As classProgressBar

Sub SetupProgressBar(Optional ByVal strCaption As String)

    Set ThisProgressBar = New classProgressBar

    With ProgressBar
        .Show vbModeless
        .Caption = Format(strCaption)
        With ThisWorkbook.Sheets(2)
            ThisProgressBar.Denominator = Application.CountA(.Columns(1))
        End With
        If ThisProgressBar.Denominator = 0 Then ThisProgressBar.Denominator = 1
        ThisProgressBar.Numerator = 0
        .Frame1.Caption = Format(ThisProgressBar.Numerator & " / " & ThisProgressBar.Denominator, "@")
        .Label1.Width = ThisProgressBar.Numerator / ThisProgressBar.Denominator * 170
        DoEvents
    End With

End Sub


Sub UpdateProgressBar(Optional ByVal strCaption As String, Optional ByVal lngNewProgressNumerator As Long = -1)

    With ProgressBar
        If lngNewProgressNumerator = -1 Then
            ThisProgressBar.Numerator = ThisProgressBar.Numerator + 1
        Else
            ThisProgressBar.Numerator = lngNewProgressNumerator
        End If
        .Caption = Format(strCaption)
        .Frame1.Caption = Format(ThisProgressBar.Numerator & " / " & ThisProgressBar.Denominator, "@")
        .Label1.Width = ThisProgressBar.Numerator / ThisProgressBar.Denominator * 170
        DoEvents
    End With

End Sub

classProgressBar

Private pNumerator As Long
Private pDenominator As Long


'pNumerator Properties
Public Property Get Numerator() As Long
    Numerator = pNumerator
End Property
Public Property Let Numerator(Numerator As Long)
    pNumerator = Numerator
End Property

'pDenominator Properties
Public Property Get Denominator() As Long
    Denominator = pDenominator
End Property
Public Property Let Denominator(Denominator As Long)
    pDenominator = Denominator
End Property

classQueryMetaParameters

Private pstrQueryName As String
Private pboolActive As Boolean
Private pstrSQLApp As String
Private pstrDatabase As String
Private pstrDataSource As String
Private pstrUsername As String
Private pstrPassword As String
Private pstrQuery As String
Private pstrResearchClause As String
Private pintItemsAtOnce As Integer
Private pintResearchItemColumn As Integer


'pstrQueryName Properties
Public Property Get strQueryName() As String
    strQueryName = pstrQueryName
End Property
Public Property Let strQueryName(strQueryName As String)
    pstrQueryName = strQueryName
End Property


'pboolActive Properties
Public Property Get boolActive() As Boolean
    boolActive = pboolActive
End Property
Public Property Let boolActive(boolActive As Boolean)
    pboolActive = boolActive
End Property


'pstrSQLApp Properties
Public Property Get strSQLApp() As String
    strSQLApp = pstrSQLApp
End Property
Public Property Let strSQLApp(strSQLApp As String)
    pstrSQLApp = strSQLApp
End Property


'pstrDatabase Properties
Public Property Get strDatabase() As String
    strDatabase = pstrDatabase
End Property
Public Property Let strDatabase(strDatabase As String)
    pstrDatabase = strDatabase
End Property


'pstrDataSource Properties
Public Property Get strDataSource() As String
    strDataSource = pstrDataSource
End Property
Public Property Let strDataSource(strDataSource As String)
    pstrDataSource = strDataSource
End Property


'pstrUsername Properties
Public Property Get strUsername() As String
    strUsername = pstrUsername
End Property
Public Property Let strUsername(strUsername As String)
    pstrUsername = strUsername
End Property


'pstrPassword Properties
Public Property Get strPassword() As String
    strPassword = pstrPassword
End Property
Public Property Let strPassword(strPassword As String)
    pstrPassword = strPassword
End Property


'pstrQuery Properties
Public Property Get strQuery() As String
    strQuery = pstrQuery
End Property
Public Property Let strQuery(strQuery As String)
    pstrQuery = strQuery
End Property


'pstrResearchClause Properties
Public Property Get strResearchClause() As String
    strResearchClause = pstrResearchClause
End Property
Public Property Let strResearchClause(strResearchClause As String)
    pstrResearchClause = strResearchClause
End Property


'pintItemsAtOnce Properties
Public Property Get intItemsAtOnce() As Integer
    intItemsAtOnce = pintItemsAtOnce
End Property
Public Property Let intItemsAtOnce(intItemsAtOnce As Integer)
    pintItemsAtOnce = intItemsAtOnce
End Property


'pintResearchItemColumn Properties
Public Property Get intResearchItemColumn() As Integer
    intResearchItemColumn = pintResearchItemColumn
End Property
Public Property Let intResearchItemColumn(intResearchItemColumn As Integer)
    pintResearchItemColumn = intResearchItemColumn
End Property
\$\endgroup\$
2
\$\begingroup\$

As I noted in chat, you will want to pay particular attention to code smells. To start, make sure you read this article (https://www.joelonsoftware.com/2005/05/11/making-wrong-code-look-wrong/) and his other articles as well. While some of this stuff may be difficult to implement at first, breaking bad habits now goes a long way. That out of the way, lets dig in.

Hungarian Notation

I used to be a big fan of hungarian notation. My code was riddled with oFoo and sBar. Hungarian notation is harmless, right? It wasnt until Comimterm pointed out to me that I had completely missed a potentially code breaking variable that looked like it had a type, but was never defined with a Type. As a result, I never saw it. Inevitably, I forgot to fix it too, and it came back and bit me in the butt.

Why is hungarian notation so bad? I'm glad you asked. Most commonly, it allows us to become lazy as we are declaring variables. Take your classQueryMetaParameters class for example. The name in itself is a mouthful. If you create a new instance, you have to declare it as a classQueryMetaParameters and, to boot, you dont get much help from intellisense until you hit the Q.

Second, within the class you have this little nugget: strDatabase. I don't know about you, but I have no way of fitting a database into a string. Of course this isnt actually a Database. It is likely a DatabaseName, or DatabasePath, or DatabaseSomethingOrAnother. Why don't we have to be a little bit better with our name? Because we could have a recordsetDatabase, and a strDatabase and the compiler will compile happily.

The key here is this: you, as the programmer, knows what strDatabase means but no one else will. Trust me, when you have to fix the project a year from now, you will be kicking yourself in the butt.

Defining Custom Classes

This one I stole from @Mat's Mug so full credit goes to him. Frankly, I thought the suggestion was borderline cumbersome at first, but it has made a tremendous difference. Note the code below:

Option Explicit
Type TQuerymetaParameters
    QueryName As String
    IsActive As Boolean
    Username As String
    Password As String
    Query As String
    ResearchClause As String
    ItemsAtOnce As Long
    ResearchItemColumn As Long

    ' These three names are non-descriptive. Your user has little clue what they do.
    ' Break the habit of relying on hungarian notation. It may *work* but it is a code smell.
    SQLApp As String
    Database As String
    DataSource As String
End Type

Private this As TQuerymetaParameters

Public Property Get QueryName() As String
    QueryName = this.QueryName
End Property
Public Property Let QueryName(value As String)
    this.QueryName = value
End Property

Note the subtle elegance of the code. I didn't notice the effect this has when I first started writing classes in this way, until I had about 10 different classes and I had the RD explorer open. From top down:

  • We define the properties of the class using a type. This type is only known to the class, and as such keeps things nice and neat.
  • Next, we get to declare a variable called 'this' that allows us to access these properties. This gives us intellisense on our properties.
  • Finally, our property accessors explicitly change the values within the type. This is clear to even the newest of VBA programmers. Further, another plug for intellisense here. How easy is it to make a type on a pFooAndABar and as a result, the entire program has to start over?

I also want to note here that your original property accessors dont use 'value'. You must switch to using value. The reason why is quite simple:

Public Property Get Foo() As String
    Foo = pFoo
End Property
Public Property Let Foo(pFoo As String)
    ' Doesnt work
    pFoo = pFoo
End Property
Public Property Let Foo(Foo As String)
    ' This will try to assign the value of pFoo to the Get Foo
    pFoo = Foo
End Property
Public Property Let Foo(value As String)
    ' Works without issue
    pFoo = value
End Property

Workaholic Subroutines

One of my worst habits used to be that I would pack as much of a process as I could into a single routine. I had an aversion to too many subroutines and too many modules. The way I saw it, get it all done in one go, without having to jump all over the place. See below:

Sub DetectQueriesSheetMetaParameterErrors(ByVal lngQueryCellRow As Long)

    With Queries
        '--- Database ---
        'Empty despite being mandatory
        If QueryMetaParameters.strDatabase = "" Then
            MsgBox "Please add a database to the " & QueryMetaParameters.strQueryName & " query."
            Cancel
        End If

        'Unrecognized value
        With DatabaseTable
            Dim lngDatabaseColumn As Long
            lngDatabaseColumn = .Rows(1).Find(What:="Database", Lookat:=xlWhole).Column
            Dim rngDatabaseMatch As Range
            Set rngDatabaseMatch = .Range(.Cells(2, lngDatabaseColumn), .Cells(Application.CountA(.Columns(lngDatabaseColumn)), lngDatabaseColumn)).Find(What:=QueryMetaParameters.strDatabase, Lookat:=xlWhole)
            If rngDatabaseMatch Is Nothing Then
                MsgBox "The Database listed for the " & QueryMetaParameters.strQueryName & " query does not appear in the Database column on the Database Table sheet. Please correct the Database on the Queries sheet or add the appropriate information to the Database Table sheet."
                Cancel
            Else
                Dim lngDatabaseTableRow As Long
                lngDatabaseTableRow = rngDatabaseMatch.Row
            End If
        End With

        '--- Query without Comments ---
        'Empty despite being mandatory
        If QueryMetaParameters.strQuery = "" Then
            MsgBox "Please add code to the Query without Comments column for the " & QueryMetaParameters.strQueryName & " query."
            Cancel
        End If
        'Comments present in query
        If InStr(1, QueryMetaParameters.strQuery, "--", vbTextCompare) > 0 Then
            MsgBox "Please remove all comments (" & "--" & ") from the " & QueryMetaParameters.strQueryName & " query."
            Cancel
        End If

        '--- Research Item Clause ---
        Dim lngResearchClauseColumn As Long
        lngResearchClauseColumn = .Rows(1).Find(What:="Research Item Clause", Lookat:=xlWhole).Column

        'Silent failures
        'User didn't put anything (Change it to N/A (Ignore the Research items sheet))
        If QueryMetaParameters.strResearchClause = vbNullString Then
            QueryMetaParameters.strResearchClause = "N/A"
            .Cells(lngQueryCellRow, lngResearchClauseColumn).Value = "N/A"
        End If
        'Closes with a space
        If Right(QueryMetaParameters.strResearchClause, 1) = " " Then
            Do Until Right(QueryMetaParameters.strResearchClause, 1) <> " "
                QueryMetaParameters.strResearchClause = Left(QueryMetaParameters.strResearchClause, Len(QueryMetaParameters.strResearchClause) - 1)
            Loop
            .Cells(lngQueryCellRow, lngResearchClauseColumn).Value = QueryMetaParameters.strResearchClause
        End If

        'Noisy failures
        'Closes with two ))
        If Right(QueryMetaParameters.strResearchClause, 2) = "))" Then
            Do Until Right(QueryMetaParameters.strResearchClause, 2) <> "))"
                .Cells(lngQueryCellRow, lngResearchClauseColumn).Value = Left(.Cells(lngQueryCellRow, lngResearchClauseColumn).Value, Len(.Cells(lngQueryCellRow, lngResearchClauseColumn)) - 1)
                QueryMetaParameters.strResearchClause = .Cells(lngQueryCellRow, lngResearchClauseColumn).Value
            Loop
        End If
        'Present on Queries sheet but not present in query
        If InStr(1, QueryMetaParameters.strQuery, QueryMetaParameters.strResearchClause, vbTextCompare) = 0 And QueryMetaParameters.strResearchClause <> "N/A" Then
            MsgBox "Research item clause for the " & QueryMetaParameters.strQueryName & " query is not present in the actual query code. Please match the research item clause to the query."
            Cancel
        End If
        'Research item clause closes with non-)
        If Right(QueryMetaParameters.strResearchClause, 1) <> ")" And QueryMetaParameters.strResearchClause <> "N/A" Then
            MsgBox "Please end your Research Item Clause for the " & QueryMetaParameters.strQueryName & " query with a )."
            Cancel
        End If
    End With

End Sub

Walk yourself through this, and count how many processes it is responsible for. If I was refactoring your code I wouldnt want to touch this with a ten foot pole. There is just too much there, doing too much at once.

There are ten separate clauses, and at least a few cancels in here. This is a prime example of what subroutines are meant for.

Consider this (somewhat hasty) example of using a function, and bubbling up the error at the same time.

Sub Baz()
    Dim MatchedRow As Long
    MatchedRow = Foo(DatabaseTable)

    If Foo <> 0 Then
        DoSomethingElse
    Else
        MsgBox "The Database listed for the " & QueryMetaParameters.strQueryName & " query does not appear in the Database column on the Database Table sheet. Please correct the Database on the Queries sheet or add the appropriate information to the Database Table sheet."
        Cancel
    End If
End Sub
Function Foo(ByVal InputDatabaseTable As Variant) As Long
    With DatabaseTable
        Dim lngDatabaseColumn As Long
        lngDatabaseColumn = .Rows(1).Find(What:="Database", Lookat:=xlWhole).Column

        Dim rngDatabaseMatch As Range
        Set rngDatabaseMatch = .Range(.Cells(2, lngDatabaseColumn), .Cells(Application.CountA(.Columns(lngDatabaseColumn)), lngDatabaseColumn)).Find(What:=QueryMetaParameters.strDatabase, Lookat:=xlWhole)

        If Not rngDatabaseMatch Is Nothing Then
            Foo = rngDatabaseMatch.Row
        End If
    End With
End Function

What I did is I still got the row that was needed, but now the error that would occur without the row is immediately surfaced. It may look the same, but by putting this approach into practice your code will naturally stop because the logic will tell it to since it will only continue to the next process within the if block.

At first, putting this style into practice can be somewhat tedious. Where we could previous just use a mess of If blocks, we now have to use functions, and we have to consider how we want those functions to return variables. In the end though, this approach (at least in my experience) makes it much easier to surface the error where it happens, and to keep the code clean.

I want to also note here that the practice of a Cancel method is dangerous, and is a code smell in itself. Cancelling the routine, if necessary, is innocuous. The danger comes in when you rely on Cancel.

Finally, think of Workaholic subroutines this way: they may work really really hard, and they may do their job perfectly every time. But just because they can brute force it on their own now, doesnt mean they can do it forever. It is much easier to debug a team of subroutines, each with their own task and responsibility, than it is to look at the one guy who is responsible for ten different things. If you think of it in this way, it becomes much clearer why subroutines and the 'S' of SOLID becomes important.

\$\endgroup\$
  • \$\begingroup\$ +1 for including the suggestion to add a Type definition to the Class so you can use this. It's made a positive difference in my own coding. Good answer. \$\endgroup\$ – PeterT Jun 20 '17 at 17:14
  • \$\begingroup\$ Thanks again for all the time you spent here helping to improve my code, I really appreciate it. \$\endgroup\$ – puzzlepiece87 Jun 21 '17 at 16:05
  • \$\begingroup\$ To feel comfortable marking this answer as accepted, I'd probably need to see a few improvements or hear some additional explanation. First, for your Hungarian section, a few things. While the advice Comintern gave you was good and I acknowledge that Hungarian notation is considered bad practice, Hungarian notation wasn't responsible for your typing error. If you forget to type something, that's going to be a problem regardless of your naming convention. I'd probably strip that example or make it more of a side note. Second, as far as Intellisense, it depends on how helpful you find it to ... \$\endgroup\$ – puzzlepiece87 Jun 21 '17 at 16:17
  • \$\begingroup\$ ... see a list of all your classes when you type "class". I personally find it very helpful, but ymmv. I do appreciate your advice about good naming practices, thank you. Moving on to your "Defining Custom Classes" section, this was my favorite part of your answer and something I didn't know. Thank you very much for including it. The next section is "Outputting to the Worksheet". Unfortunately, your infamiliarity with recordsets did bite you in the butt a bit here - that method does not paste to a cell at a time. It's just using the cell as the upper left cell of the entire range being ... \$\endgroup\$ – puzzlepiece87 Jun 21 '17 at 16:18
  • \$\begingroup\$ ... pasted at once. So that entire section of the answer should be removed. Finally for the "Workaholic Subroutines" section - I agree, more abstraction is generally good. Can you please clarify what you accomplished with your example though? I'm having trouble understanding. Let's say my original code is all level 1, and your Baz sub is Level 1 and your Foo function is level 2. I do need to get better at bubbling things up, but generally what I'm working on is getting errors that happen a few levels deep (3,4,5) all the way up to the top level and gracefully informing the user and exiting ... \$\endgroup\$ – puzzlepiece87 Jun 21 '17 at 16:23

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.