ReturnRandomEntry.txt

Function ReturnRandomEntry(sType As String, testColor As String, testRarity As Integer, testCost As String, formatOption As Integer)
    Dim cn As Object, rs As Object, output As String, sql As String
    
    Dim count As Integer
    
    Dim testCostParsed As Integer
    Dim testCostComparison As String
    
    Dim stringArray As Variant
    
    'loop counter
    Dim i As Integer
    
    'parse whereString (used because I have two functions that use the same format)
    whereString = getWhereString(sType, testColor, testRarity, testCost)

    'MsgBox whereString
    
    '---Connecting to the Data Source---
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
        "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
    
    
    '---Run the SQL SELECT Query---
    sql = "SELECT COUNT(*) FROM [Cards$] " & _
         whereString
         
    Set rs = cn.Execute(sql)
    
    'Get Count
    Do
       count = rs(0)
       rs.Movenext
    Loop Until rs.EOF
    'MsgBox count
    
    ReDim stringArray(0 To count, 0 To 3)
    
    'Same query as above, but select [Name] vs Count(*)
    sql = "SELECT [NAME], [COLOR_IDENTITY], [SimpleType], [Cost2] FROM [Cards$] " & _
        whereString
    Set rs = cn.Execute(sql)
    
    'reset to beginning of file
    rs.MoveFirst
    
    i = 0
    
     Do Until rs.EOF
        stringArray(i, 0) = rs.Fields(0)
        stringArray(i, 1) = rs.Fields(1)
        stringArray(i, 2) = rs.Fields(2)
        stringArray(i, 3) = rs.Fields(3)
        i = i + 1
       rs.Movenext
    Loop
    
    position = Round(Rnd * (count - 1), 0)
    'MsgBox stringArray(position)
    
    'MsgBox Join(stringArray, vbCrLf)
    If formatOption = 1 Then
        ReturnRandomEntry = stringArray(position, 1) & "; " & stringArray(position, 2) & "; " & stringArray(position, 3) & "; " & stringArray(position, 0)
    Else
        ReturnRandomEntry = stringArray(position, 0)
    End If
    
    '---Clean up---
    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing

End Function

Function getWhereString(sType As String, testColor As String, testRarity As Integer, testCost As String)

    Dim testRarityComparison As String
    Dim upperString As String
    
    If testRarity = 2 Then
        testRarityComparison = ">="
        Else
        testRarityComparison = "="
    End If
    
    'AND [Cost2] " & ">=" & lower & "<=" & upper
    Dim lower As Integer
    Dim upper As Integer

    If testCost = 1 Then
        lower = 0
        upper = 2
        upperString = " AND [Cost2] <= " & "'" & upper & "'"
    ElseIf testCost = 2 Then
        lower = 2
        upper = 3
        upperString = " AND [Cost2] <= " & "'" & upper & "'"
    ElseIf testCost = 3 Then
        lower = 3
        upperString = ""
    End If
       
    Dim whereString As String
    
        'Cannot pass "<=" as parameters :/
    
    'Multiple colors!
    Dim colorString As String
    
    '3 colors
    If (Len(testColor) = 9) Then
        colorString = "([COLOR_IDENTITY] = " & "'" & testColor & "'" & " OR [COLOR_IDENTITY] = " & "'" & Left(testColor, 3) & Right(testColor, 3) & "'" & _
        " OR [COLOR_IDENTITY] = " & "'" & Left(testColor, 3) & Mid(testColor, 4, 3) & "'" & " OR [COLOR_IDENTITY] = " & "'" & Mid(testColor, 4, 3) & Right(testColor, 3) & "')"
        '1 to 2 colors
    Else
        colorString = "[COLOR_IDENTITY] = " & "'" & testColor & "'"
        'MsgBox colorString

    End If
    


    'If Creature, include color and non color (Artifact)
    If sType = "Creature" Then
        colorString = "(" & colorString & " OR IsNull([COLOR_IDENTITY]))"
        whereString = "WHERE [Rarity2] " & testRarityComparison & testRarity & " AND " & colorString & " And [SimpleType] = " & " '" & sType & "'" & "AND [Cost2] >= " & "'" & lower & "'" & upperString
    
        'If Artifact, include color and non color
        ElseIf sType = "Artifact" Then
            colorString = "(" & colorString & " OR IsNull([COLOR_IDENTITY]))"
            whereString = "WHERE [Rarity2] " & testRarityComparison & testRarity & " AND " & colorString & " And [SimpleType] = " & " '" & sType & "'" & "AND [Cost2] >= " & "'" & lower & "'" & upperString
            
        ElseIf sType = "Basic Land" Then
        'MsgBox "Color: " & testColor
            whereString = "WHERE [COLOR_IDENTITY] = " & "'" & testColor & "'" & " And [SimpleType] = " & " '" & sType & "'"
            
        ElseIf sType = "Special Land" Then
            'If 2 colors
            If (Len(testColor) = 6) Then
                colorString = "([COLOR_IDENTITY] = " & "'" & testColor & "'" & " OR [COLOR_IDENTITY] = " & "'" & Left(testColor, 3) & "'" & _
                " OR [COLOR_IDENTITY] = " & "'" & Right(testColor, 3) & "')"
                'If 1 color
                ElseIf (Len(testColor) = 3) Then
                    colorString = "[COLOR_IDENTITY] = " & " '" & testColor & "'"
                Else
                'If 3 colors Append Null
                colorString = "(" & colorString & " OR IsNull([COLOR_IDENTITY]))"
            End If
            whereString = "WHERE " & colorString & " And [SimpleType] = " & " '" & sType & "'"
        Else
            'Instant, Sorcery, Enchantment
            whereString = "WHERE [Rarity2] " & testRarityComparison & testRarity & " And " & colorString & " And [SimpleType] = " & " '" & sType & "'" & " AND [Cost2] >= " & "'" & lower & "'" & upperString
    End If
    
    
    'MsgBox whereString
    
    getWhereString = whereString

End Function

Function ReturnEntryCount(sType As String, testColor As String, testRarity As Integer, testCost As String)
    Dim cn As Object, rs As Object, output As String, sql As String
    
    Dim count As Integer

    Dim testCostParsed As Integer
    Dim testCostComparison As String
    
    'loop counter
    Dim i As Integer

    'parse whereString (used because I have two functions that use the same format)
    whereString = getWhereString(sType, testColor, testRarity, testCost)
    
    'MsgBox whereString
    
    '---Connecting to the Data Source---
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
        "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
    
    
    '---Run the SQL SELECT Query---
    sql = "SELECT COUNT(*) FROM [Cards$] " & _
         whereString
         
    Set rs = cn.Execute(sql)
    
    'Get Count
    Do
       count = rs(0)
       rs.Movenext
    Loop Until rs.EOF
    'MsgBox count
    
    If count = 0 Then
        'MsgBox whereString
    End If
    
 
    ReturnEntryCount = count
    
    '---Clean up---
    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing

End Function