Address Duplicate Medical Claims (with SQL Injection GUI)

Question

These are some pieces of a program I wrote to help my team automatically analyze and fix medical claims that have been rejected.

I thought some people might be interested to see what I have done to allow my team to modify a base query through what is kind of a SQL injection GUI. I had a few objectives in building this:

• Pull query logic out of the backend to where the user can see it, learn it, and suggest improvements/additions
• Make it easy to add new pieces of query logic and user options governing them
• Make it easy to add new markets that can plug into the existing logic options

---

Determine if the user asked for the default options for their market or chose custom ones:

Standard Module: M0310QueryPreparation

Option Explicit

Sub GetQueryReplacementsFromGlossaryAndQueryLogicSheet(ByVal strQueryType As String)

    'Modify the upcoming query based upon the user's choice of logic
    If IsUserFormLoaded("CustomLogicOptions") = False Then
        DefaultQueryReplacements strQueryType
    Else
        If CustomLogicOptions.Tag = "On" Then
            CustomQueryReplacements strQueryType
        Else
            DefaultQueryReplacements strQueryType
        End If
    End If

End Sub

Find which options apply to their choice (for example, these are for a user choice of the default options):

Standard Module: M03110QueryReplacements

Option Explicit

Sub DefaultQueryReplacements(ByVal strQueryType As String)

    'Find the settings for lngMarketID.Value on the State Configuration sheet and match them to query replacements on the Glossary and Query Logic sheet
    With StateConfiguration
        'Find the standard logic columns on the State Configuration sheet
        Dim lngStateConfigurationSettingNamesRow As Long
        lngStateConfigurationSettingNamesRow = .Columns(1).Find(What:="Market ID", Lookat:=xlWhole).Row
        Dim lngStateConfigurationFirstSettingColumn As Long
        lngStateConfigurationFirstSettingColumn = .Rows(1).Find(What:="Standard State-Specific Logic", Lookat:=xlWhole).Column
        Dim lngStateConfigurationLastSettingColumn As Long
        lngStateConfigurationLastSettingColumn = .Cells(lngStateConfigurationSettingNamesRow, 1).End(xlToRight).Column

        Dim rngStateConfigurationSettingNames As Range
        Set rngStateConfigurationSettingNames = .Range(.Cells(lngStateConfigurationSettingNamesRow, lngStateConfigurationFirstSettingColumn), .Cells(lngStateConfigurationSettingNamesRow, lngStateConfigurationLastSettingColumn))

        Dim lngSettingsRowForMarketIDBeingAnalyzed As Long
        lngSettingsRowForMarketIDBeingAnalyzed = WorksheetFunction.Match(lngMarketID.Value, .Columns(1), 0)

        'For the setting-options for lngMarketID.Value from the State Configuration sheet
        Dim rngStateConfigurationSetting As Range
        For Each rngStateConfigurationSetting In rngStateConfigurationSettingNames
            'If they match to a query replacement on the Glossary and Query Logic sheet
                'Store the replacement in the appropriate query replacements dictionary
            PossibleAdditionToQueryReplacementsDictionary strQueryType, rngStateConfigurationSetting.Value, .Cells(lngSettingsRowForMarketIDBeingAnalyzed, rngStateConfigurationSetting.Column).Value
        Next rngStateConfigurationSetting
    End With

End Sub

Get the matching injections from the user-facing sheet:

Standard Module: M03111QueryReplacements

Option Explicit

Sub PossibleAdditionToQueryReplacementsDictionary(ByVal strQueryType As String, ByVal strSetting As String, ByVal strOption As String)

    'If the strSetting-strOption combination matches to a query replacement on the Glossary and Query Logic sheet
        'Store the replacement in the appropriate query replacements dictionary
    With GlossaryandQueryLogic
        'Prepare to match strSetting and strOption
        Dim lngGlossarySettingColumn As Long
        lngGlossarySettingColumn = .Rows(1).Find(What:="Setting", Lookat:=xlWhole).Column
        Dim lngGlossaryOptionColumn As Long
        lngGlossaryOptionColumn = .Rows(1).Find(What:="Option", Lookat:=xlWhole).Column
        Dim lngGlossaryQueryReplacementColumn As Long
        If dictQueryLogicColumnByQueryType.Value.Exists(strQueryType) Then
            lngGlossaryQueryReplacementColumn = dictQueryLogicColumnByQueryType.Value(strQueryType)
        Else
            MsgBox "Error: A misconfiguration has occurred. The program is looking for a " & strQueryType & "Query Replacement Logic column on the " & .Name & " sheet, but is unable to find one. Please have a new column with this type of logic added to the sheet with appropriate query replacements."
            Cancel
        End If

        'Find the rows for this setting
        Dim lngGlossaryFirstRowForThisSetting As Long
        lngGlossaryFirstRowForThisSetting = .Columns(lngGlossarySettingColumn).Find(What:=strSetting, Lookat:=xlWhole).Row
        'Find the first row of the next setting and subtract one
        Dim lngGlossaryLastRowForThisSetting As Long
        If lngGlossaryFirstRowForThisSetting <> .Cells(.Rows.Count, lngGlossarySettingColumn).End(xlUp).Row Then
            lngGlossaryLastRowForThisSetting = .Columns(lngGlossarySettingColumn).Find(What:="*", After:=.Cells(lngGlossaryFirstRowForThisSetting, lngGlossarySettingColumn), SearchDirection:=xlNext, SearchOrder:=xlByRows).Row - 1
        Else
            lngGlossaryLastRowForThisSetting = .Cells(.Rows.Count, 4).End(xlUp).Row
        End If

        'Find the row for this option
        Dim rngGlossaryPossibleOptionsForThisSetting As Range
        Set rngGlossaryPossibleOptionsForThisSetting = .Range(.Cells(lngGlossaryFirstRowForThisSetting, lngGlossaryOptionColumn), .Cells(lngGlossaryLastRowForThisSetting, lngGlossaryOptionColumn))

        Dim rngGlossaryOptionForThisSetting As Range
        Set rngGlossaryOptionForThisSetting = rngGlossaryPossibleOptionsForThisSetting.Find(What:=strOption, Lookat:=xlWhole)

        'Match it to a Query Replacement
        If (rngGlossaryOptionForThisSetting Is Nothing) Then
            'Something on the State Configuration sheet needs to be fixed
            MsgBox "Error: The " & strSetting & " option for this state does not match any known options on the Glossary and Query Logic sheet. Please have a new row with this type of logic added to the sheet with appropriate query replacements."
            Cancel
        Else
            Dim strQueryReplacementLogic As String
            strQueryReplacementLogic = .Cells(rngGlossaryOptionForThisSetting.Row, lngGlossaryQueryReplacementColumn).Value
            If strQueryReplacementLogic <> vbNullString Then dictQueryReplacementDictionariesByQueryType.Value.Item(strQueryType).Add Key:=strSetting, Item:=strQueryReplacementLogic
        End If
    End With

End Sub

Get the base query (which is pasted onto the spreadsheet) and maintain its existing readability:

Standard Module: M0310QueryPreparation (same as GetQueryReplacementsFromGlossaryAndQueryLogicSheet above)

Option Explicit

Function PrepareOriginalQuery(ByVal QuerySheet As Worksheet) As String

    'Build the query from the pieces
    Dim strQuery As String
    strQuery = vbNullString
    With QuerySheet
        Dim lngLastRowOfQuery As Long
        lngLastRowOfQuery = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        Dim lngRowIndex As Long
        For lngRowIndex = 2 To lngLastRowOfQuery
            Dim rngNewLineOfQueryText As Range
            Set rngNewLineOfQueryText = .Range(.Cells(lngRowIndex, 2), .Cells(lngRowIndex, .Columns.Count)).Find(What:="*")
            If Not rngNewLineOfQueryText Is Nothing Then
                Dim lngTabIndex As Long
                lngTabIndex = 2 'Starts at 2 due to Settings Column
                Do Until lngTabIndex = rngNewLineOfQueryText.Column
                    strQuery = strQuery & vbTab
                    lngTabIndex = lngTabIndex + 1
                Loop
                strQuery = strQuery & rngNewLineOfQueryText.Value
            End If
            strQuery = strQuery & vbCrLf
        Next lngRowIndex
    End With

    PrepareOriginalQuery = strQuery

End Function

Make the injections and ensure that they are SQL-compliant

Standard Module: M0310QueryPreparation (same as two other methods above)

Option Explicit

Function CleanQuery(ByVal strOriginalQuery As String, ByVal dictQueryReplacements As Scripting.Dictionary) As String

    Dim strCleanedQuery As String
    strCleanedQuery = strOriginalQuery

    'Make replacements of settings placeholders in query
    Dim Loop1 As Long
    For Loop1 = LBound(dictQueryReplacements.Keys) To UBound(dictQueryReplacements.Keys)
        If dictQueryReplacementSettingsThatAreNotWhereClauseConditions.Value.Exists(dictQueryReplacements.Keys(Loop1)) = True Then
            strCleanedQuery = Replace(strCleanedQuery, "--" & dictQueryReplacements.Keys(Loop1), dictQueryReplacements.Items(Loop1))
        Else
            strCleanedQuery = Replace(strCleanedQuery, "--" & dictQueryReplacements.Keys(Loop1), "and " & dictQueryReplacements.Items(Loop1))
        End If
    Next Loop1

    'Remove extraneous "and"s
    Dim lngAndLocation As Long
    lngAndLocation = InStr(1, strCleanedQuery, "and ", vbTextCompare)
    Do Until lngAndLocation = 0
        Dim boolBeginningOfPreviousWordFound As Boolean
        boolBeginningOfPreviousWordFound = False
        Dim strPreviousWord As String
        strPreviousWord = vbNullString
        Dim lngCharactersBackFromAnd As Long
        lngCharactersBackFromAnd = 0
        Do Until boolBeginningOfPreviousWordFound = True
            lngCharactersBackFromAnd = lngCharactersBackFromAnd + 1
            Dim strCurrentCharacter As String
            strCurrentCharacter = Mid(strCleanedQuery, lngAndLocation - lngCharactersBackFromAnd, 1)
            Select Case strCurrentCharacter
                Case vbCrLf, vbTab, " ", vbCr, vbLf
                    If strPreviousWord <> vbNullString Then boolBeginningOfPreviousWordFound = True
                Case Else
                    strPreviousWord = strCurrentCharacter & strPreviousWord
            End Select
        Loop
        If strPreviousWord = "where" Or strPreviousWord = "on" Then
            strCleanedQuery = Left(strCleanedQuery, lngAndLocation - 1) & Right(strCleanedQuery, Len(strCleanedQuery) - lngAndLocation - 3)
            lngAndLocation = lngAndLocation - 1
        End If
        lngAndLocation = InStr(lngAndLocation + 1, strCleanedQuery, "and", vbTextCompare)
    Loop

    CleanQuery = strCleanedQuery

End Function

Answer 1

First - I think the design of your code, as well as the logic, are good. I'm not sure why you have a bunch of modules, but I'm just testing it all in a single module.

Variable Naming

You're using some Hungarian notation. Read more.

What I mean is you're putting the Type prefix on all your variables -

strQueryType
dictQueryReplacements
rngNewLineOfQueryText
lngStateConfigurationSettingNamesRow

There's no real need for that. The name of your variable should make it clear what Type it is. The lngStateConfigurationSettingNamesRow is a row, it's obviously going to be an integer, so I don't need that prefix letting me know.

(Ignoring that this might not be possible) -With rngStateConfigurationSettingNames you can let me know it's a range like configSettingsHeaderRange or, better yet, give these ranges names, as in create named ranges on the worksheet. So instead, it might look like this

Set settingHeaders = SettingSheet.Range("ConfigurationHeaders")

Right? You can tell me a lot with names, and you can avoid those huge lines.

Usually I'm like "Hey give your variables meaningful names! Characters are free!", but here, you've gone above and beyond naming your variables. In fact, the names are a little overwhelming. If that's your style, then that's your style, it's just a bit much if someone were to come after you and try to debug given variable names take up half the screen area.

---

Being Explicit

You've done an excellent job ensuring that everything is properly qualified e.g.

Set rngGlossaryPossibleOptionsForThisSetting = .Range(.Cells()), .Cells())

There's no chance that you will hit the wrong sheet, having wrapped it in a With.

---

Error Handling

You've trapped your error, at the least ones you expect, in If blocks (VBA Guard Clauses) -

If (rngGlossaryOptionForThisSetting Is Nothing) Then
    'Something on the State Configuration sheet needs to be fixed
     MsgBox "Error: The " & strSetting & _ 
   " option for this state does not match any known options on _
   the Glossary and Query Logic sheet. Please have a new row with 
   this type of logic added to the sheet with appropriate query replacements."
     Cancel
Else

The only thing is the use of Cancel. You haven't declared a Cancel so I imagine you want to use the built in cancel, but your functions don't have a cancel argument (and instead errors). Instead, if you want to stop the procedure use Exit Function or Exit Sub

Your error messages are pretty long too, perhaps put those in a variable so the error block doesn't seem so lopsided. Even put them in a constant.

However, the block seems backwards to me. You're testing for the error and relying on the Else to do it all. Instead, test that there isn't an error and guard in the Else

    If Not rngGlossaryOptionForThisSetting Is Nothing Then
        Dim strQueryReplacementLogic As String
        strQueryReplacementLogic = .Cells(rngGlossaryOptionForThisSetting.Row, lngGlossaryQueryReplacementColumn).Value
        If strQueryReplacementLogic <> vbNullString Then dictQueryReplacementDictionariesByQueryType.Value.Item(strQueryType).Add Key:=strSetting, Item:=strQueryReplacementLogic
    Else
       'Something on the State Configuration sheet needs to be fixed
        MsgBox "Error: The " & strSetting & ErrorMessage
        Exit Function
    End If

---

Boolean If

If dictQuery...Value.Exists(dictQueryReplacements.Keys(Loop1)) = True 
If IsUserFormLoaded("CustomLogicOptions") = False

When you test a boolean, you can just use the boolean as the test

If dictQuery.Value.Exists() Then
If Not IsUserFormLoaded("Custom") Then

---

Strings

Since Mid, Left and Right only return strings, you can use the Typed functions Mid$,Left$ and Right$

---

Comments

You have a lot of comments. Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.