find transactions within 30 days

Question

I have a list of transactions with columns below. There are over thousand of rows of transactions. I need to find transaction with at least 12 or more of the same AccountName that has aggregate amount of more than $10,000 within a 30 day period. Please help. I am not sure how to even start. I just started looking at VBA this week. This will be in Excel using Macro.

Transaction ID; Amount; Date; AccountName

Hope this makes sense. I am looking for 12 or more transactions with the same accountname that has aggregate amount of more than $10,000 within a 30-day period.

Thank you so much!!

score 0 · Answer 1 · answered Oct 01 '14 at 02:40

I recommend an ADO Recordset because of the flexibility of the recordset.Filter property. I was able to use it to traverse each row of the source table at most only one time. The logic is as follows:

Get the source data into a Recordset.
Filter the Recordset to only include records with the same ‘AccountName’.
If there are more than 12 records (i.e. transactions, which is one of your requirements) in the Filtered set, then proceed. Otherwise, update the Filter to exclude this ‘AccountName’ and get the next one.
Create an array with one element for each day between the first and last day of transactions and store the sum of the day’s transactions in it.
Keep a running sum of the previous 30 days’ worth of totals. If the total exceeds $10000, store the ‘AccountName’, the starting date of the 30-day window and the transaction total.
Reset the Recordset filter to exclude the previous processed accounts and process the next ‘AccountName’.
When all ‘AccountName’s have been processed, create a new Worksheet and copy the results to it.

The code reads a spreadsheet with at least three columns of data: 'Amount', 'Date' and 'AccountName'. See below:

Option Explicit

Sub AggregateWithinWindow()
    Dim xlXML As Object     'MSXML2.DOMDocument
    Dim rs As Object        'ADODB.Recordset
    Dim ws As Worksheet
    Dim rng As Range
    Dim colResults As Collection
    Dim dblRunSum As Double
    Dim aDaySums() As Double
    Dim ar(2) As Variant
    Dim sFltr As String, sAcctName As String
    Dim lDateLow As Long, lDateHigh As Long, lWndLow As Long, i As Long, j As Long

    ' Get the data from the spreadsheet into an ADO Recordset using the approach shown by kulshresthazone at http://usefulgyaan.wordpress.com/
    Set rng = Application.ActiveSheet.UsedRange
    Set rs = CreateObject("ADODB.Recordset")
    Set xlXML = CreateObject("MSXML2.DOMDocument")
    xlXML.LoadXML rng.Value(xlRangeValueMSPersistXML)
    rs.Open xlXML
    Set rng = Nothing
    Set xlXML = Nothing


    Set colResults = New Collection

    rs.Sort = "[Date] ASC"

    sAcctName = rs.Fields("AccountName").Value
    rs.Filter = "[AccountName] = '" & sAcctName & "'"

    Do While Not rs.EOF
        If rs.RecordCount >= 12 Then
            rs.MoveLast
            lDateHigh = CLng(rs.Fields("Date").Value)
            rs.MoveFirst
            lDateLow = CLng(rs.Fields("Date").Value)
            ReDim aDaySums(lDateHigh - lDateLow)

            dblRunSum = 0
            lWndLow = 0
            sAcctName = rs.Fields("AccountName").Value

            Do While Not rs.EOF
                i = CLng(rs.Fields("Date").Value) - lDateLow
                Do While Not rs.EOF
                    If CLng(rs.Fields("Date")) - lDateLow = i Then
                        aDaySums(i) = aDaySums(i) + rs.Fields("Amount").Value
                        rs.MoveNext
                    Else
                        Exit Do
                    End If
                Loop

                If i - lWndLow <= 30 Then
                    dblRunSum = dblRunSum + aDaySums(i)
                Else
                    If dblRunSum > 10000 Then
                        ar(0) = sAcctName
                        ar(1) = CDate(lWndLow + lDateLow)
                        ar(2) = dblRunSum
                        colResults.Add ar
                    End If

                    dblRunSum = dblRunSum + aDaySums(i)

                    For j = lWndLow To i - 31
                        dblRunSum = dblRunSum - aDaySums(j)
                    Next j

                    lWndLow = i - 30
                End If
            Loop
        End If
        If sFltr = "" Then
            sFltr = "[AccountName] <> '" & sAcctName & "'"
        Else
            sFltr = sFltr & " and [AccountName] <> '" & sAcctName & "'"
        End If
        rs.Filter = sFltr
        If Not rs.EOF Then rs.Filter = sFltr & " and [AccountName] = '" & rs.Fields("AccountName").Value & "'"
    Loop

    rs.Close
    Set rs = Nothing

    Set ws = Application.ActiveWorkbook.Sheets.Add
    ws.Name = "Results"

    ws.Cells(1, 1).Value = "AccountName"
    ws.Cells(1, 2).Value = "WindowStartDate"
    ws.Cells(1, 3).Value = "WindowAggregate"

    For i = 1 To colResults.Count
        ws.Range(ws.Cells(i + 1, 1), ws.Cells(i + 1, 3)) = colResults.Item(i)
    Next i

    Set ws = Nothing

End Sub

find transactions within 30 days

1 Answers1