Well, I am getting closer in resolving my issue. I am able to get my response (Yes or No) in the correct column and row for each Policy Number. Now the problem is comparing the actual value of what the user enter versus the database table (ADO) in order to get the correct response. I am getting an error 3265 and I cannot figure it out but it has something to do with the Array coding. In using the debugging, I can see the values for each of the RPolicy fields but it is only capturing the first record and not including it in the Array.

Here is my code:

Sub CBreader()

    'Establish connection and record set with CRMDB
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    
    
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset
    
    'Declare field variables
    Dim vArray As Variant
    Dim rPolicy(0 To 4) As Variant
    Dim FPolicy As Range
    Dim PN As Range
    Dim FBlock As String
    Dim FMsg As String
    Dim wb As Workbook
    Dim WS As Worksheet
    Dim i As Long
    Dim BCount As Long
    Dim STPolicy As String
    
          
    Set wb = ThisWorkbook
    
    'Activate Workbook & Worksheet
    Set WS = wb.Worksheets("EF")
    WS.Activate
       
    'Open the ODBC Connection using this statement

    With WS
        
        RCount = .Range("D" & .Rows.Count).End(xlUp).Row
        Set FPolicy = .Range("D7:D" & RCount)
             
        cnn.Open "CRMDB", "[USERNAME]", "[PASSWORD]"
        rst.ActiveConnection = cnn
        rst.CursorLocation = adUseServer
        
        STPolicy = CriteriaFromRange(FPolicy)
        
        rst.Source = "Select * FROM u_CloseBlock WHERE [u_CloseBlock].[Policy] in (" & STPolicy & ")"
        rst.Open
        
               
        Do While Not rst.EOF
        
        For i = 1 To RCount
        'Get records into array
        rPolicy(0) = rst.Fields("Company")
        rPolicy(1) = rst.Fields("Policy")
        rPolicy(2) = rst.Fields("Status")
        rPolicy(3) = rst.Fields("Plan_Code")
        rPolicy(4) = rst.Fields("Block_No")
                        
        vArray = rst.GetRows(rst.RecordCount, , rPolicy(i))
        Next i
                     
        BCount = Range("D" & Rows.Count).End(xlUp).Row
        
        For Each PN In ActiveSheet.Range("D7:D" & BCount)
            For Each rPolicy(0) In vArray
        
                If PN.Value = rPolicy(1).Value Then
                    FBlock = rPolicy(4).Value
                                
                    Select Case Trim(PN.Value)
                        Case FBlock = "1011"
                            FMsg = "Yes"
                            .Cells(PN.Row, "K").Value = FMsg
                        Case FBlock <> "1011"
                            FMsg = "No"
                            .Cells(PN.Row, "K").Value = FMsg
                    End Select
                Else
                    .Cells(PN.Row, "K").Value = "Not Found"
                End If
            Next rPolicy(1)
        Next PN
        rst.MoveNext
        Loop
         
    End With
       
    'Close everything and set the references to nothing
    rst.Close
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing
    
     
 End Sub
Please let me know what I am doing wrong. Any suggestion is welcome. Thank you.