0

Example Transaction Set:

Example Transaction Set

Note the 3 transactions shown. The two transactions highlighted in green are the ones I'd like to delete or flag (doesn't matter).

Using VBA, the code is way too clunky. The code takes forever to run because

  1. I loop through each transaction in column C until I find a negative.
  2. Set Column E as the absolute value target if not zero, else absolute value D.
  3. Define the range for a specific account so that I can begin looping through it to find value in step 2.
  4. If I find the value, I delete both rows (one containing negative and the one which isn't a negative).

My apologies for not commenting code. This was not 100% done yet.

Sub ReversalScrub()

Dim AccountNumber As String
Dim TargetAmount As Double
Dim TargetRange As Range
Dim Transactions As Range
Dim Transaction As Variant
Dim DeletionCount As Integer

    Set RawTransactions = Worksheets("RawTransactions")

    With RawTransactions
            Set Transactions = .Range("C1", .Range("C2").End(xlDown))

    End With

    TransactionRow = 2

    Do Until TransactionRow = Transactions.Rows.Count

        If Range("C" & TransactionRow).Value < 0 Then

            If Range("C" & TransactionRow).Offset(0, 2).Value < 0 Then

                TargetAmount = Abs(Range("C" & TransactionRow).Offset(0, 2).Value)
            Else
                TargetAmount = Abs(Range("C" & TransactionRow).Offset(0, 1).Value)
            End If

                AccountNumber = Range("C" & TransactionRow).Offset(0, -2).Value

                Set TargetRange = GetAccountRange(AccountNumber, RawTransactions)

                CurrentRow = TargetRange.Row

                Do Until CurrentRow = TargetRange.Rows.Count - 1
                    If (TargetAmount = Range("E" & CurrentRow).Value Or TargetAmount = Range("D" & CurrentRow).Value) Then
                        Range("A" & CurrentRow).EntireRow.Delete
                        Range("C" & TransactionRow).EntireRow.Delete
                        CurrentRow = CurrentRow - 2
                        Exit Do

                    End If
                    CurrentRow = CurrentRow + 1
                Loop
        End If
        TransactionRow = TransactionRow + 1
    Loop

End Sub

So then I decided to write a function to see if it would be faster.

  1. Column F: Check if the transaction is negative. If so, create a key using account number, abs(column D), abs(column E). =IF((C91<0),A91&ABS(D91)&ABS(E91))
  2. Column G: Create a key account number, column D, Column E. =A91&D91&E91
  3. Column H: Check whether column F exists within G using Match. =IFERROR(MATCH(F91,$G$1:G91,0),FALSE)
  4. Column I: Check whether actual cell row, matches that of column H from step. =IFERROR(MATCH(ROW(H91),H:H,0),FALSE)
  5. Column J: Check whether H or I are number (MATCH output), if so, they are flagged as reversals and the user can delete them. =IF(OR(ISNUMBER(H91),ISNUMBER(I91)),"Reversal",IF(C91=0,"Zero",""))

The problem is that this, too, crashes my computer. How can I effectively find duplicates and remove them without removing the third row?

Second solution sample:

Second solution sample

  • Have you tried using condition formatting for duplicates? – BillDOe Dec 26 '18 at 20:35
  • I cannot use conditional formatting in this case because only 2 out of 3 would be duplicates. Specifically, the 3rd transaction wouldn't be a duplicate. A payment was made (Tran1), it was then reversed (Tran2), and then the customer paid again (Tran3). So in this case, only the first 2 transactions would be removed. – Nahuatl_C137 Dec 26 '18 at 20:38
  • @Nahuatl, you have made it so complicated since ultimately you are Deleting both with -ve & +ve sign Value. Write me whether you would like to delete Rows has Duplicate data in Col C or only Rows which have -ve value in C? – Rajesh S Dec 27 '18 at 9:18
1

This seems to work with a small data set. Try it and adjust as needed. I'm flagging cell F with a reversal message.

This looks through column C until it finds an empty cell. If you have empty cells you will need to adjust the Do Until loop.

I am skipping cells that have been flagged previously (not empty cell F)

Note it will only flag 1 cell as matching.

Sub FlagReversals()

Dim MyExit As String
Dim PosLoc
Dim NegLoc
Dim NegAmt
Dim PosAmt

Range("C2").Select

  Do Until IsEmpty(ActiveCell)
    If ActiveCell.Value < 0 And IsEmpty(ActiveCell.Offset(0, 3).Value) Then
       NegLoc = ActiveCell.Address
       Acct = ActiveCell.Offset(0, -2)
       NegAmt = ActiveCell.Value
       PosAmt = Abs(ActiveCell.Value)
       MyExit = "False"
       Do Until MyExit = "True"
          If ActiveCell.Offset(-1, 0).Row > 1 Then
             ActiveCell.Offset(-1, 0).Select
          Else
             Range(NegLoc).Select
             ActiveCell.Offset(1, 0).Select
             MyExit = "True"
          End If
          If Acct = ActiveCell.Offset(0, -2) And IsEmpty(ActiveCell.Offset(0, 3).Value) And MyExit = "False" Then
             If PosAmt = ActiveCell.Value Then
               ' found the match (by account and value)
               ActiveCell.Offset(0, 3).Value = "Reversal from address " & NegLoc
               PosLoc = ActiveCell.Address
               Range(NegLoc).Select
               ActiveCell.Offset(0, 3).Value = "Reversal from address " & PosLoc
               MyExit = "True"
             End If
          End If
       Loop
    End If
  ActiveCell.Offset(1, 0).Select
  Loop

End Sub

Edit: Cleaned up infinite loop when no match found.

  • Great solution and very easy to follow! – Nahuatl_C137 Dec 27 '18 at 14:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.