Another Disconnected Recordset Example

I had to do some pretty extensive filtering recently and employed disconnected recordsets to speed up the code, which it did. Except that I ran into a bug, or so I thought. When I made the ADODB.Recordset variable a private module level variable in the class, I got a run time error. I don’t recall the error, but I believe it was “Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record.” when I called the MoveFirst method. I checked my filter strings and all was OK. Then I checked RecordCount after removing the filter and it was zero.

No problem, I must have a bug in the code that populates the recordset. I step through the code and get no errors. The code looks basically like this

For Each clsTransaction In Me
    .AddNew
   
    .Fields(“TransactionID”).Value = clsTransaction.TransactionID
    .Fields(“TransType”).Value = clsTransaction.TransType
    .Fields(“TransDate”).Value = clsTransaction.TransDate
    .Fields(“RefNum”).Value = clsTransaction.RefNum
    .Fields(“Vendor”).Value = clsTransaction.Vendor
    .Fields(“Memo”).Value = clsTransaction.Memo
    .Fields(“Account”).Value = clsTransaction.Account
    .Fields(“Amount”).Value = clsTransaction.Amount
    .Fields(“Note”).Value = clsTransaction.Note
   
    .Update
Next clsTransaction

After each Update, I checked the RecordCount property and it was zero. It should have gone up each time. I stepped through the code a second time and got an error on the second .Fields.Append of code that looks like this

    With mrsTransactions
        .Fields.Append “TransactionID”, adInteger
        .Fields.Append “TransType”, adVarChar, 50
        .Fields.Append “TransDate”, adDate
        .Fields.Append “RefNum”, adVarChar, 50
        .Fields.Append “Vendor”, adVarChar, 50
        .Fields.Append “Memo”, adVarChar, 254
        .Fields.Append “Account”, adVarChar, 100
        .Fields.Append “Amount”, adDouble
        .Fields.Append “Note”, adVarChar, 254
       
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
       
        .Open

I got that error on the second append line. TransactionID appended fine, but TransType errored. I checked the recordset variable and saw that all nine fields were already in the recordset, even though I had destroyed and recreated the variable. Something strange was happening. Whenever something strange happens, I export all the modules and reimport them. That didn’t work this time.

My next step was to delete the module level recordset variable, create a local variable in the procedure, and pass it to other procedures as an argument. Once I made that change, everything worked great. It was clear that I’d found a bug dealing with ADO recordsets as module level variables in class modules. Sounds like a good blog post. I recreated the code with nonsensitive data and, you guessed it, no error.

That was a little disheartening, but I always had my original workbook that would reliably produce an error. I went back to that workbook, and rewrote the code back to the way it was when I got the error. Except that now I don’t get the error. Someone or something is conspiring against me. That was a lot of work to find out that there isn’t a bug. I’m not letting all that work go to waste, though. All of the above is a long-winded explanation for why I’m posting another disconnected recordset example. So here it is.

I’m not happy with the pivot table I produce to analyze overhead expenses. I’ve been fighting with it for a few years and I finally decided to just roll my own pivot table and make it the way I want. I have a worksheet with a listing of all of the overhead transactions for a certain period. I have another worksheet with notes I’ve made for specific transactions. The third and final worksheet is the “pivot table”.


The output looks like this

Note the comment in B3. If a transaction has a note, I put it in a comment to the cell so I don’t have to wonder why Raw Material Purchases was so low in January when I’m updating this six months from now.

Sub RefreshOH()
   
    Dim clsTransactions As CTransactions
    Dim clsTransaction As CTransaction
    Dim vaList As Variant
    Dim aHead(1 To 1, 1 To 14) As String
    Dim i As Long
    Dim rAcct As Range, rMonth As Range
    Dim rTrans As Range, rNotes As Range
   
    ‘Reset the worksheet
   wshOhPivot.UsedRange.ClearContents
    wshOhPivot.UsedRange.ClearComments
   
    ‘Fill the collection class
   Set clsTransactions = New CTransactions
    Set rTrans = wshOhExp.Range(“A2”, wshOhExp.Range(“A2”).End(xlDown)).Resize(, 7)
    Set rNotes = wshOhNotes.Range(“A2”, wshOhNotes.Cells(wshOhNotes.Rows.Count, 1).End(xlUp)).Resize(, 8)
    clsTransactions.FillFromArray rTrans.Value
    clsTransactions.AddNotes rNotes.Value
       
    ‘Create the header
   aHead(1, 1) = “Account”
    For i = 2 To 13
        aHead(1, i) = Format(DateSerial(2011, i – 1, 1), “mmm”)
    Next i
    aHead(1, 14) = “Total”
    wshOhPivot.Range(“A2”).Resize(UBound(aHead, 1), UBound(aHead, 2)).Value = aHead
   
    ‘Fill the data
   vaList = clsTransactions.List
    wshOhPivot.Range(“A3”).Resize(UBound(vaList, 1), UBound(vaList, 2)).Value = vaList
   
    ‘Add comments for notes
   For Each clsTransaction In clsTransactions
        If clsTransaction.HasNote Then
            Set rAcct = wshOhPivot.Columns(1).Find(clsTransaction.Account, , xlValues, xlWhole)
            Set rMonth = wshOhPivot.Rows(2).Find(Format(clsTransaction.TransDate, “mmm”), , xlValues, xlWhole)
            If Not rAcct Is Nothing And Not rMonth Is Nothing Then
                Intersect(rAcct.EntireRow, rMonth.EntireColumn).AddComment _
                    clsTransaction.Note & ” “ & Format(clsTransaction.Amount, “$#,##0.00”)
            End If
        End If
    Next clsTransaction
   
End Sub

After the existing data is deleted, the collection class is filled. I pass it an array of values from the range and create child classes.

Public Sub FillFromArray(vaInput As Variant)
   
    Dim i As Long
    Dim clsTransaction As CTransaction
   
    For i = LBound(vaInput, 1) To UBound(vaInput, 1)
        Set clsTransaction = New CTransaction
       
        With clsTransaction
            .TransType = vaInput(i, 1)
            .TransDate = vaInput(i, 2)
            .RefNum = vaInput(i, 3)
            .Vendor = vaInput(i, 4)
            .Memo = vaInput(i, 5)
            .Account = vaInput(i, 6)
            .Amount = vaInput(i, 7)
        End With
       
        Me.Add clsTransaction
    Next i
   
End Sub

The AddNotes method finds the right clsTransaction instance and updates the Note Property. It’s not terribly exciting, but you can look at the code in the workbook if you like. Let’s get right to the meat; the List method

Public Property Get List() As Variant
   
    Dim aReturn() As Variant
    Dim colAccts As Collection
    Dim i As Long, j As Long
    Dim clsTransaction As CTransaction
    Dim sMonth As String
   
    Me.FillRs
   
    Set colAccts = Me.UniqueAccounts
           
    ReDim aReturn(1 To colAccts.Count + 1, 1 To 14)
   
    For i = 1 To colAccts.Count
        ‘Put the account name in the first column
       aReturn(i, 1) = colAccts.Item(i)
        ‘Sum the amounts by account and month for the rest of the columns
       For j = 1 To 12
            aReturn(i, j + 1) = Me.AmountByMonthAccount(j, colAccts.Item(i))
        Next j
        ‘Sum the amounts by account for the last columnn
       aReturn(i, 14) = Me.AmountByAccount(colAccts.Item(i))
    Next i
   
    ‘Sum by month for column totals
   For j = 1 To 12
        aReturn(colAccts.Count + 1, j + 1) = Me.AmountByMonth(j)
    Next j
   
    List = aReturn
       
End Property

The AmountByMonthAccount, AmountByAccount, and AmountByMonth properties are all pretty much the same. They all filter the recordset and loop through the records adding up the Amount field.

Public Property Get AmountByMonthAccount(lMonth As Long, sAcct As String) As Double
   
    Dim dReturn As Double
    Dim sWhere As String
    Dim i As Long
       
    sWhere = “TransDate >= #” & Format(DateSerial(Year(Now), lMonth, 1), “mm/dd/yyyy”) & “#” & _
        ” AND TransDate < = #” & Format(DateSerial(Year(Now), lMonth + 1, 0), “mm/dd/yyyy”) & “#” & _
        ” AND Account = ‘” & sAcct & “‘”
   
    With mrsTransactions
        .Filter = adFilterNone
        .Filter = sWhere
        If Not .BOF And Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                dReturn = dReturn + .Fields(“Amount”).Value
                .MoveNext
            Loop
        End If
    End With
   
    AmountByMonthAccount = dReturn
   
End Property

It might actually be faster to create a pivot table, grab the data I want, and write it to a sheet. But I wanted an excuse to use disconnected recordsets again, and this afforded me that excuse.

You can download Overhead.zip

Posted in Uncategorized

8 thoughts on “Another Disconnected Recordset Example

  1. I downloaded the example, and there seems to be a bug in the period-totals when I run the macro. All the periods are filled with amounts. I changed the year in the code to 2013.

  2. I was pretty sloppy with my date handling in the example file. It’s been fixed. The fix was to replace all four instances of Year(Now) to 2011.

  3. Thanks but I still can’t get it to work. I live in The Netherlands, can it be a date-format issue? I will try to rewrite it with booking-periods instead of dates myself, because it wouldn’t be very polite to ask for it.

  4. Your version works for me when changing de date-code to “dd\-mmm\-yyyy” a tip from Rob van Gelder on this site.
    Right now I’m testing the add comments part. When I have two rows with the same account I get an error: Application-defined or object-defined error.

  5. I read more about the Add Comment part. The macro isn’t working when there is a comment already. So when there is one comment for each account it is working. It would be great if you could fix this.

  6. Erik: In RefreshOH, declare a variable

    Dim sComment As String

    then near the bottom, change the code to

    If Not rAcct Is Nothing And Not rMonth Is Nothing Then
    sComment = vbNullString
    With Intersect(rAcct.EntireRow, rMonth.EntireColumn)
    On Error Resume Next
    sComment = .Comment.Text
    On Error GoTo 0
    If Len(sComment) = 0 Then
    .AddComment clsTransaction.Note & " " & Format(clsTransaction.Amount, "$#,##0.00")
    Else
    .Comment.Delete
    .AddComment sComment & vbNewLine & clsTransaction.Note & " " & Format(clsTransaction.Amount, "$#,##0.00")
    End If
    End With
    End If


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published. Required fields are marked *