VBA Recordset Help

[talt0612]

Hi All-
I have a problem I hope someone can help me with. In a nutshell, I'm trying to use data in an existing table (table1) to "look up" data in another table (table2) and summarize the data from table2 in table1. Here is an example:
table1:

LoadDate	FundName	NAV
3/8/13	HY-EUR
3/8/13	HY-GBP

<tbody>
</tbody>

table2:

Load Date	FundDetailID	InputType	Amount
3/7/13	HY-EUR	NAV	100
3/8/13	HY-EUR	NAV	101
3/8/13	HY-GBP	P/L	102
3/10/13	HY-CAD	NAV	103

<tbody>
</tbody>

So basically I want to loop through the FundName field of table1 and if they exist in table2, AND the dates match in both tables, then move the Amount field from table2 to table1 in the NAV field. I've used a recordset for things like this in the past, but I'm having trouble tonight (I'm tired and a little rusty). To be clear, I need a solution in VBA and I can NOT use a pivot table. Below is the code I'm working with:

Public Enum InputHedgeColumns
    LoadDate = 1
    FundName = 2
    NAV = 3
    End Enum
 ----------------------------------------------------------------   
Sub TestHedgeUpdate()
 


Application.ScreenUpdating = False


   
    Dim HedgeSheet, Input_All As Worksheet
    Dim sInputData As ListObject
    
   
Set HedgeSheet = ThisWorkbook.Sheets("HedgeSheet")
Set Input_All = ThisWorkbook.Sheets("Input_All")
Set sInputData = [HedgeInputData].ListObject


    
    Application.DisplayAlerts = False
    
   
    Dim intCount As Integer
    intCount = 2


    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                            "Data Source=" & ThisWorkbook.FullName & ";" & _
                            "Extended Properties=""Excel 12.0 Macro;" & _
                            "HDR=YES"";"
      
        .Open
      

  ''Process the Input Table - For each row of Input Data, apply the filter condition and store the result in the Output file
    For Each Item1 In sInputData.ListRows
    
            inputDataRow = Item1.Range.Value
    
            
       sGlobalDate = [GlobalLoadDt]
    
''''''''''''Type mismatch error on next line'''''''''''''''''''''''''''''''''''''''''''''''''''   
strQuery = "SELECT [Amount]  FROM [InputAllTable]" _
                                    & "WHERE [FundDetailID] IN ('" & inputDataRow(1, InputHedgeColumns.FundName) & ") " & _
                                    "AND [LoadDate] = #" & sGlobalDate & "#" And [InputType] & " = 'NAV'"
                                    
            With rs
                .Open strQuery, cn, 3, 3
            End With
            
           HedgeSheet.Range("HedgeInputData[[NAV]]").CopyFromRecordset rs
          
            
            rs.Close
        Next
    
        .Close
    End With
    
    
  


Application.DisplayAlerts = True
End Sub

 

[dermie_72]

have you thought about using sumifs instead of looping? Just a thought.

A = application.worksheetfunction.sumifs(.....

then use and if A isnum then do what you want
else dont do it.

 

[Fazza]

Below code works for me in Excel 2003. Late bound. Assumes headers per sample data, named ranges "table1" and "table2" & file saved. Please modify to suit your requirements.

Sub TestHedgeUpdate()

  Dim strConn As String
  Dim strSQL As String
  Dim objRS As Object

  strConn = Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
      ActiveWorkbook.FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)

  strSQL = Join$(Array( _
      "UPDATE table1 T1", _
      "INNER JOIN table2 T2 ON T1.LoadDate = T2.[Load Date]", _
      "SET T1.NAV = T2.Amount", _
      "WHERE T1.FundName = T2.FundDetailID"), vbCr)

  Set objRS = CreateObject("ADODB.Recordset")
  objRS.Open strSQL, strConn
  Set objRS = Nothing
  
End Sub

 

[talt0612]

Thanks dermie_72 and Fazza for your kind suggestions. I neglected to mention that I was using Excel 2010. I found solution w/ the below code (adopted from some earlier work I'd done). Perhaps it will help someone else using excel as a "database".

Option Explicit
Public conn As New ADODB.Connection
Public rcd As New ADODB.Recordset
Public strSQL As String

Public Sub OpenDB()
    If conn.State = adStateOpen Then conn.Close
    conn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
    ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
    'On Error Resume Next
    conn.Open
End Sub

Public Sub closeRS()
    If rcd.State = adStateOpen Then rcd.Close
    rcd.CursorLocation = adUseClient
End Sub

Public Enum InputHedgeColumns
    LoadDate = 1
    FundName = 2
   NAV=3
 End Enum

Sub UpdateNAVs()




    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
  
    Dim HedgeSheet, Input_All As Worksheet
    Dim sGlobalDate As String
    Dim sInputData As ListObject
   
Set HedgeSheet = ThisWorkbook.Sheets("HedgeSheet")
Set Input_All = ThisWorkbook.Sheets("Input_All")
Set sInputData = [HedgeInputData].ListObject




    
  Dim intCount As Integer
    intCount = 1
    
    ''Process the Hedge Input Table - For each row of Input Data, apply the filter condition and store the result in the NAV, P/L, etc location
    For Each Item1 In sInputData.ListRows
    
            inputDataRow = Item1.Range.Value
   
     NAV = "NAV"
    sGlobalDate = [GlobalLoadDt]
    
    strSQL = "SELECT [Amount] FROM [table2$] WHERE "
        strSQL = strSQL & " [FundDetailID] = '" & inputDataRow(1, InputHedgeColumns.FundName) & "'"
        strSQL = strSQL & " AND [Input Type]='" & NAV & "'"
        strSQL = strSQL & " AND [LoadDate]=#" & sGlobalDate & "#"
        
       
    'now extract data
        
        'close old recordsets (if any)/open new database
        closeRS
        
        OpenDB
        
        rcd.Open strSQL, conn, adOpenKeyset, adLockOptimistic
            HedgeSheet.Range("HedgeInputData[[NAV Amount]]").Cells(intCount).CopyFromRecordset rcd
           
            rcd.Close
                intCount = intCount + 1
        Next
    
    conn.Close
    
With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

 

[Fazza]

I suspect much simpler is simply changing the connection string to suit Excel 2010 in the code I posted. I can't test that though. cheers