Filter recordset by excel column data

[brian0782]

Hi everyone

I'm new to here and the world of VBA (just started coding couple of days ago).

I have a spreadsheet that contains order ids and what I'd like to do is populate the adjacent column with related information from our sql server db.

I have made a lot of progress but what I'm struggling with is passing the order id from Sheet1 to my subroutine. I have tried defining rsFilter and using that in the WHERE clause in my sql query.

I think I'm on the right path but I need to list all values in my filter (A1:A10) so my recordset only returns the info for the existing order ids. Getting a 'subscript out of range' error at rrsFilter = Worksheets("Sheet1").Range("A1:A10").Value
.

I constructed this using a variety of sources so this might be a little inefficient. Thanks in advance. Brian

Sub FindCardOrders()


' Initialize variables.
Dim cn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim provStr As String
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim rsFilter As String




' Create new instances
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset


' Define Filter
rsFilter = Worksheets("Sheet1").Range("A1:A10").Value


' sql query
sql = "SELECT TOP 100 t.tri_transactionidcode," _
& "SUBSTRING(t.tri_reference, 1, 9) AS merchantref," _
& "t.tri_additionalreferencenumber, t.CreatedOn, t.tri_amount, ISNULL(t.tri_paymenttransactiontypeidName, 'Online')" _
& " FROM dbo.tri_onlinepayment t INNER JOIN dbo.tri_transaction tr ON tr.tri_onlinepaymentid = t.tri_onlinepaymentId" _
& " WHERE t.tri_transactionresult = 9"
'& " AND t.tri_transactionidcode = '" & rsFilter & "'"


' Specify the OLE DB provider.
cn.Provider = "sqloledb"


' Specify connection string on Open method.
cn.Open "Data Source=xxxx;Database=IFL_MSCRM;Trusted_Connection=yes;Integrated Security=SSPI"


' Assign active connection to recordset
Set rs.ActiveConnection = cn
'intMaxCol = rs.Fields.Count


' Define cursors and open sql
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockBatchOptimistic
rs.Open sql
intMaxCol = rs.Fields.Count
intMaxRow = rs.RecordCount
rs.MoveLast
rs.MoveFirst
rs.Filter = rsFilter



If rs.RecordCount > 0 Then
With Worksheets("Sheet1")
.Range("B1:B2").CopyFromRecordset rs
End With
End If

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing




End Sub

 

[brian0782]

Bump

Can anyone point me in the right direction please? Apologies if I haven't followed the correct protocol when creating a new thread.

 

[Fazza]

hello & welcome, Brian

The line you've queried is : rsFilter = worksheets("whatever").range("A1:A10").value

rsFilter is dimmed as string. See the problem? A string variable and wanting to assign an array of 10 values.

Via a loop (instead of the current line getting all 10 values at once) the filter string can be obtained for each cell, one at a time. So loop through from A1:A10 and one cell at a time assign the cell value to the string variable. Do what you have to with it. That is not the only way, of course.

Another way, with the idea to be faster as all the reading from the worksheet is in one operation, is to read the A1:A10 entries into an array. Now loop through this array doing what you have to with each entry one at a time. Something like

dim ar() as variant
with worksheets("whatever").range("A1:A10")
redim ar(1 to .rows.count, 1 to .columns.count)
ar=.value2
end with
for i = lbound(ar,1) to ubound(ar,1)
rsFilter = ar(i,1)
'do something with each filter
next i

Another idea, maybe just for info as may not be easy to implement. Run UPDATE queries to the worksheet. First to initialise, UPDATE [worksheet_name$] SET fieldname Is Null
Then to update from database. UPDATE `full path and connection info`.[worksheet_name$] WS INNER JOIN DatabaseTables DT ON WS.common = DT.common SET WS.fieldname = DT.field

Another way may be to include the filter values in the SQL. So a bit like the last line of SQL that you've commented out. You could run 10 queries & handle each result individually (to update the worksheet) or you could pull all (potentially) 10 results in a single recordset. Then loop through the recordset to handle updating the worksheet. Just watch out for when there is no data for one of the (10) worksheet filters. Such as there is data for 8 only of the 10 you ask for. The SQL could be like this, which you can make in VBA, it is just a string manipulation. It would be like

AND t.tri_transactionidcode IN ('value from cell A1', 'value from next cell', 'another one', 'etc for all 10')

A little familiarity may be all you need. So just keep going. Google and asking questions will help. All the best. Regards, Fazza

 

[Fazza]

Hello again, Brian

My earlier comments may have not addressed what you're after. I re-visited this with some code to create the filter. As I mentioned above, be aware that the filter is for (in the example) 10 codes but if not all 10 have data there will be fewer than 10 codes returned from the query.

regards, Fazza

Sub FindCardOrders()



    ' Initialize variables.
    Dim cn As ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim provStr As String
    Dim intMaxCol As Integer
    Dim intMaxRow As Integer
    Dim rsFilter As String


    ' Create new instances
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset


    ' Define Filter
'==================================
    Dim i As Long
    Dim ar As Variant


    With Worksheets("Sheet1").Range("A1:A10")
        ReDim ar(1 To .Rows.Count, 1 To .Columns.Count)
        ar = .Value2
    End With
    rsFilter = ar(1, 1)
    For i = 2 To UBound(ar, 1)
        rsFilter = rsFilter & "', '" & ar(i, 1)
    Next i
    Erase ar
    rsFilter = "IN ('" & rsFilter & "')"


    ' sql query
    Sql = "SELECT TOP 100 t.tri_transactionidcode," _
            & "SUBSTRING(t.tri_reference, 1, 9) AS merchantref," _
            & "t.tri_additionalreferencenumber, t.CreatedOn, t.tri_amount, ISNULL(t.tri_paymenttransactiontypeidName, 'Online')" _
            & " FROM dbo.tri_onlinepayment t INNER JOIN dbo.tri_transaction tr ON tr.tri_onlinepaymentid = t.tri_onlinepaymentId" _
            & " WHERE t.tri_transactionresult = 9" _
            & " AND t.tri_transactionidcode " & rsFilter


'==================================
'after here unchanged

 

[brian0782]

Hi Fazza

Thanks for your reply. I've moved on a bit from the original question and managed to make a bit of progress. My routine is working as intended but having trouble with error handling.

Does my code make sense and is it laid out in the correct order? Just want to ensure the steps are logically in the correct order etc.

Sub FindCardOrders()


' Initialize variables.
Dim cn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i As Integer
Dim payid As Variant
Dim myString As String
Dim crmSearch As String


'On Error GoTo ProcError


Workbooks("ifl_macros.xlsm").Activate
Worksheets("FindCardPayments").Activate


payid = Range("pay_id_range", Range("pay_id_range").End(xlDown)).Select


With Selection.Font
    .Size = 12
    .Name = "Arial"
End With


myString = ""


Debug.Print ActiveWorkbook.Name
Debug.Print ActiveSheet.Name


' Create new instances
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset


payid = Range("pay_id_range", Range("pay_id_range").End(xlDown)).Value


i = 1


For i = LBound(payid) To UBound(payid)
        myString = myString & payid(i, 1)
        myString = myString & ","
Next i


myString = myString & payid(UBound(payid), 1)
   
' sql query
sql = "SELECT  t.tri_transactionidcode, t.tri_reference," _
    & " tr.tri_transactiondate, t.tri_amount, ISNULL(t.tri_paymenttransactiontypeidName, 'Online')" _
    & " FROM dbo.tri_onlinepayment t INNER   JOIN dbo.tri_transaction tr ON tr.tri_onlinepaymentid = t.tri_onlinepaymentId" _
    & " WHERE 1=1" _
    & " AND t.tri_transactionidcode IN (" & myString & ")"
    
' Specify the OLE DB provider.


With cn
    .Provider = "sqloledb"
    .ConnectionTimeout = 0
    .CommandTimeout = 0
    .Properties("Prompt") = adPromptAlways
    .Open "Data Source=IFL-SQL11;Database=IFL_MSCRM;Trusted_Connection=yes;Integrated Security=SSPI"
End With


With rs
    .ActiveConnection = cn
    .CursorLocation = adUseServer
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    .Open sql
    .Filter = adFilterNone
End With


Debug.Print rs.AbsolutePosition
Debug.Print rs.RecordCount


For Each payid In Range("pay_id_range")
     
     '// Belt and braces - make sure RS at first record
    rs.MoveFirst
    Debug.Print rs.AbsolutePosition
    Debug.Print rs.CursorLocation
     
    crmSearch = "[" & rs.Fields(0).Name & "]='" & payid.Value & "'"


    rs.Find crmSearch, 0, adSearchForward


     '// Either BOF or EOF (and most likely both) will be True if not found
    If rs.EOF Or rs.BOF Then
    With payid.Offset(0, 1)
        .Value = "#N/A"
        .Interior.Color = RGB(220, 20, 60)
    End With
        Debug.Print rng.Value & " DOES NOT exist in recordset"
    Else
        Debug.Print payid.Value & " exists in recordset"
    
    For i = 0 To 4
        For j = 1 To 5
            With payid.Offset(0, j)
            .Value = rs.Fields.Item(i)
            .Interior.Color = RGB(255, 255, 153)
            i = i + 1
            End With
        Next j
     Next i
    End If
Next


'ProcExit:


    cn.Close
    Set cn = Nothing
    rs.Close
    Set rs = Nothing
    
    'Exit Sub


'ProcError:
'
'    MsgBox "This macro has encountered an error. Error: " & Err.Description
'    Resume ProcExit


End Sub

 

[Fazza]

First up, a comment on the original question. It was based on there being 10 inputs. If there are 10,000 that won't be a good approach.

Here are some links on error handling,

http://www.cpearson.com/excel/errorhandling.htm

<tbody>
</tbody>

http://dailydoseofexcel.com/archives/2007/05/04/error-handling-template/

http://dailydoseofexcel.com/archives/2014/01/02/error-handling-via-an-error-class/

I've read there can be whole books on error handling. Any good book on VBA will cover the subject. An excellent book is
http://www.amazon.com/Professional-Excel-Development-Definitive-Applications/dp/0321508793

If the code works, that is a good start. Must make sense and be in order. There will be things that can be done differently but I wouldn't sweat it too much. Just keep learning.

I am not wanting to comment too much on the code. Various things in no particular order, some of which may be wrong: dim i as integer might be better as as long; could create a function to check if workbook exists/is open; working with worksheet names is risky, better to use code name; selecting things is normally avoided; mystring = "" could be mystring = vbnullstring; range("pay_", range("pay_").end(xldown)) could be a problem if the cell below range("pay_") is empty, consider using end.(xlup) from bottom of worksheet, or using .currentregion.resize(); you could probably do without the ADODB.Connection altogether; payid variable is originally a variant and then re-used as a range, better to have to separate variables & explicitly dim the range as such; it is good to see the objects explicitly set to nothing when finished (that is cn & rs); if there were LOTS of payids being looped & written to a worksheet, you might look instead at using an array and reduce worksheet write operations. If you're looking at distributing the code be aware of the ADODB references; consider changing to late binding. Good error handling & defensive coding is worthwhile.

All the best. Regards