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
.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
.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.
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.
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
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.
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
re: “… Someone or something is conspiring against me. …”
Perhaps this? http://support.microsoft.com/kb/319998
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.
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) to2011.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.
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.
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.
Erik: In RefreshOH, declare a variable
Dim sComment As Stringthen near the bottom, change the code to
If Not rAcct Is Nothing And Not rMonth Is Nothing ThensComment = 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
Hi Dick, it works now! Thanks for your time. I will definitely use this is in my work.