Excel VBA program to detect automatically

[Dostonus]

Hi folks
Need your help, I am beginner Excel VBA coder. I got stuck on developing a program,
I have following data set:
- There is a database of card transactions of individuals
- Time coverage is more than 3 years
- Number of transactions is more than 1 000 a day
- each transaction has following details: Transaction order, Customer name, Card number, Date of transaction, Amount of transaction,
the requirements are the followings:
I have to develop excel application that shows me: sum of transactions that exceeds X (for ex: 10 000 USD) amount of money in last 30 days by one individual customer

In the attached image I have developed SUMIFS function but I could write codes in VBA to make swift Excel Application that shows me automatically results

 

[mumps]

How do you determine which customer and what amount (X)?

 

[Dostonus]

Actually I need for every customer and amount is here : 115 000 000

 

[mumps]

Do you want to create a new sheet for each customer showing the sum of transactions that exceeds 115 000 000? If not, where do you want to record the data for each customer?

 

[Dostonus]

It would be great to record all customers transactions that exceeds 115 000 000 within the last 30 days in the new worksheet in the new workbook.

 

[mumps]

Try this macro. Change the table name (in red) to match your actual table name.

Sub Dostonus()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object, WS1 As Worksheet, cnt As Long, key As Variant, x As Long: x = 1
    Set WS1 = ThisWorkbook.Sheets("Sheet1")
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Rng In WS1.Range("D5", WS1.Range("D" & WS1.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next
    Workbooks.Add
    For Each key In RngList
        With WS1
            If x = 1 Then
                With .ListObjects("Table2")
                    .Range.AutoFilter Field:=2, Criteria1:=key
                    .Range.AutoFilter Field:=8, Criteria1:=">115000000"
                    cnt = .AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count - 1
                    If cnt > 0 Then
                        .Range.SpecialCells(xlCellTypeVisible).Copy Cells(1, 1)
                        x = x + 1
                    End If
                End With
            Else
                With .ListObjects("Table2")
                    .Range.AutoFilter Field:=2, Criteria1:=key
                    .Range.AutoFilter Field:=8, Criteria1:=">115000000"
                    cnt = .AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count - 1
                    If cnt > 0 Then
                        WS1.Range("C5", WS1.Range("K" & WS1.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    End If
                End With
            End If
        End With
    Next key
    WS1.Range("C4").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Dostonus]

Hi there again, mumps
Could you please help me again? The code is working and filtering out the results but and creating new excel file but not copying out the results

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail how it is not working for you.