How to use RANGE Statment - Receiving Error 1004

Ugh! I apologize that my sample report did not format correctly. The data is for the column (Policy Number).

Thank you for your comments and I will review the rules.

Thank you again!

Thank you for your comments and I have reviewed the rules.

I have changed my title and thank you FDibbins for marking my codes with the tags.

Abousetta - I made the changes as you suggested, but still receiving error 1004 - Method "Range of object_Global" failed.

I will do some research on this and keep you posted if I am able to resolve this.

If there are any other suggestions, I will welcome it.

Thank you.

I am looking for any new suggestion to my problem. I am still getting an error 1004. Any help will be greatly appreciated.

Okay, I will give it a try. Thank you

One more thing, I forgot to put in my previous post, I highlighted the code that I am using in red. I tried the Offset clause but it did not work for me properly.

Thank you abousetta and Izandol for your responses and suggestions. I apologize for not responding sooner, had problems in accessing this site from work.

Anyway, in using your suggestions, it has helped alot and now I am dealing with one issue. As the program matches the policy number against the ADOBC record, in column K, it should write either "Yes" (that it contains the Block Code "1011") or "No" (that it does not). It works for the first row (row 7) but it does not continue after that. I am wondering what I have done wrong.

Below are the codes that I am using along with my little "tweaks":

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
    
    'Dim strSQL As String
    
    'Declare field variables
    Dim GetItem As String
    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 RCount As Long
    Dim BCount As Integer
    Dim counter1 As Integer
    Dim MPolicy As String
    Dim STPolicy As String
    
       
    counter1 = 7
    BCount = 7
    
    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 Each PN In ActiveSheet.Range("D7:D" & BCount)
            If BCount = 7 Then
                MPolicy = PN.Value
            Else
                MPolicy = PN.Offset(1, 0).Value
            End If
        
                MPolicy = rst.Fields("Policy").Value
               'MPolicy = rst.Fields("Policy")
                FBlock = rst.Fields("Block_No")
              
             With PN
                If FBlock = "1011" Then
                    FMsg = "Yes"
                    .Range("K", counter1).Value = FMsg
                    '.Offset(BCount, 7).Value = FMsg
                ElseIf IsNull(FBlock) Then
                    FMsg = "No"
                    Range("K", counter1).Value = FMsg
                    '.Offset(BCount, 7).Value = FMsg
                End If
            End With
                        
                counter1 = counter1 + 1
                BCount = BCount + 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
 
 Function CriteriaFromRange(rgCriteria As Range) As String
 
 Dim Cell As Range
 Dim sTemp As String
 
 For Each Cell In rgCriteria.Cells
    If Len(Cell.Value) > 0 And sTemp = " " Then
        sTemp = "'" & Cell.Value & "'"
    ElseIf Len(Cell.Value) > 0 And sTemp <> " " Then
        sTemp = sTemp & ",'" & Cell.Value & "'"
    End If
 Next Cell
 
 'Now strip off leading comma
 CriteriaFromRange = Mid$(sTemp, 2)
 End Function
 
 Function EscapeQuotes(sInput As String) As String
    EscapeQuotes = Replace(sInput, "'", "'")

 End Function

Any suggestions would be welcomed. Thank you.

Hi Abousetta,

Happy New Year!
I used the BCount for my range in Column D and set the count at 7 so that it can correspond with the row that I wished to use. As for the "Counter1", I am using that for Column K to correlate with Column D and post my response (Yes or No).

I thought with this current code, that I was adding "1" to the counters and it will be used in the Range as the row counter.

Where did I go wrong?

Okay, I would like to set column D from D7 until the Last Row. The same goes for Column K.

I will go back to research using this information and work on the code. Thanks.

Hi Abousetta,

Thank you again for your response and suggestion. What will happen with column K (for the Yes or No response)? Do I need to add a similar code for that column or just rely on the outcome from column D to post the response in column K?

I am still having problems in getting "Yes" or "No" to appearing in column K. At first, the responses started to appearing in column N instead of K, so I added an offset clause and now it is appearing in the correct column but not starting on the correct row. Here is my updated code. I will highlight in red the updated 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
    
    'Dim strSQL As String
    
    'Declare field variables
    Dim GetItem As String
    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 RCount As Long
    Dim BCount As Long
    Dim counter1 As Integer
    Dim MPolicy As String
    Dim STPolicy As String
    
          
    Set wb = ThisWorkbook
    
    'Activate Workbook & Worksheet
    Set WS = wb.Worksheets("EF")
    WS.Activate
       
    'Open the ODBC Connection using this statement

    counter1 = 7
    
    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
               
        BCount = Range("D" & Rows.Count).End(xlUp).Row
        
        For Each PN In ActiveSheet.Range("D7:D" & BCount)
                
                MPolicy = PN.Value
                
                MPolicy = rst.Fields("Policy").Value
                FBlock = rst.Fields("Block_No")
    
             With PN
               If FBlock = "1011" Then
                    FMsg = "Yes"
                    .Range("K7:K" & counter1).Offset(counter1, -3).Value = FMsg
                   
                ElseIf IsNull(FBlock) Or FBlock = " " Then
                    FMsg = "No"
                    .Range("K7:K" & counter1).Offset(counter1, -3).Value = FMsg
                    
               End If
               
               counter1 = counter1 + 1
               
        End With
        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
 
 Function CriteriaFromRange(rgCriteria As Range) As String
 
 Dim Cell As Range
 Dim sTemp As String
 
 For Each Cell In rgCriteria.Cells
    If Len(Cell.Value) > 0 And sTemp = " " Then
        sTemp = "'" & Cell.Value & "'"
    ElseIf Len(Cell.Value) > 0 And sTemp <> " " Then
        sTemp = sTemp & ",'" & Cell.Value & "'"
    End If
 Next Cell
 
 'Now strip off leading comma
 CriteriaFromRange = Mid$(sTemp, 2)
 End Function
 
 Function EscapeQuotes(sInput As String) As String
    EscapeQuotes = Replace(sInput, "'", "'")

 End Function

Whew! Excel VBA is harder than I thought.

Any suggestion is welcome. Thanks.

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.

Since the issue with error 1004 has been resolved, I will close out this request. Now that I have a new error 3265, I will create a new request. Thank you to all that responded and helped me with this problem.