title: VBA Create a macro to match items in a bank reconciliation - payment booking/ Bank debit
body: <p>I have an excel based bank reconciliation that I'm doing a manual matching like the example below using ABS or conditional format, but I need to do a faster matching with a macro.</p>
  
  <p>This is the format of the bank reconciliation</p>
  
  <pre><code>                          HSBC BANK RECONCILIATION      
  Date   Ref  Type         Doc#       Description                Amount           
  
  03/31   1   Payment      991893     FUNDING GFR 2423           3.000.000,00
  
  03/22   2   Bank Debit   991893     International Payment      (3.000.000,00)
  </code></pre>
  
  <p>This is a Payment Booked in the Accounting Books with a Reference number/Description and amount, and also added the type of adjustment or action required in the last column.</p>
  
  <p>I need to highlight both lines when both doc# are the same and the sum of the amounts net to zero, just then move to a sheet called "Compensated Items", </p>
  
  <p>Some details</p>
  
  <ul>
  <li><p>I've hide some columns not needed, as month/abs/comments/adjusmtents.</p></li>
  <li><p>the headers columns are:</p></li>
  <li><p>Date: A</p></li>
  <li><p>Type: D</p></li>
  <li><p>Doc#: E</p></li>
  <li><p>Description: F</p></li>
  <li><p>Amount: G</p></li>
  <li><p>Adjustment: J</p>
  
  <ul>
  <li><p>Also I can have a Bank Credit that should match to a Receivable.</p></li>
  <li><p>I could match also if only the amounts are netting to zero as some banks don't    put good references or doc# to match.</p></li>
  </ul></li>
  </ul>
  
  <hr>
  
  <p>Below the Code I made so far to compensate items by ABS:</p>
  
  <pre><code>Sub CompensationMacro2()
  
  'Automated Bank Reconciliation Process'
  '**********************************'
  '****Made by Juan Martin Castro****'
  '**********************************'
  '-------------------------------------------------------------'
  'VBA Code to compensate Items 80% Functional
  'VBA Code to Move items to Compensation tab 100% functional
  'Improvements to add later:
  'Accruals
  'Bank Charges
  'Fundings
  'Reclass
  'JE's that shouldn't be in the rec
  'Add First Macro of Compensation code
  'InputBox Bank Rec period linked to the "Summary" sheet
  '-------------------------------------------------------------'
  
  Dim positive As Currency
  Dim negative As Currency
  Dim positive As Long
  Dim negative As Long
  Dim i As Integer
  Dim m As Integer
  Dim o As Integer
  
  
  i = 1
  LastRow = Cells(20000, 6).End(xlUp).Row
  m = 1
  o = 2
  
  Range("G2").Select
  
  Do
  
  Application.DisplayAlerts = False
  
  positive = Cells(2, 7).Offset(m, 0).Value
  negative = Cells(2, 7).Offset(o, 0).Value
  positiveRow = Cells(2, 7).Offset(m, 0).Row
  negativeRow = Cells(2, 7).Offset(o, 0).Row
  
  If positive + negative = 0 Then
  
  'Highlight compensated items
  
  Cells(positiveRow, 7).Interior.Color = rgbLightBlue
  Cells(negativeRow, 7).Interior.Color = rgbLightBlue
  Cells(positiveRow, 7).Offset(0, 2).Value = "Compensated"
  Cells(negativeRow, 7).Offset(0, 2).Value = "Compensated"
  
  'Filter by Color
  ActiveSheet.Range("$A$2:$N$25").AutoFilter Field:=7, Criteria1:=RGB(173, _
      216, 230), Operator:=xlFilterCellColor
  
  'Select Range
  
  Range("A2").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  
  'Copy to the "Compensated" sheet
  
  Selection.Copy
  Sheets("Compensated").Select
  Cells(20000, 1).End(xlUp).Offset(2, 0).Select
  ActiveSheet.Paste
  Sheets("Pending Items").Select
  
  'Delete Lines from "Pending Items" sheet
  
  Range("A2").Offset(1, 0).Delete
  Range("A2").Offset(1, 0).Delete
  
  ActiveSheet.ShowAllData
  
  'm = m + 1
  
  Else
  
  ' Call Next loop
  
  Call SecondItinerationSearchForCompensation
  
  End If
  
  'o = o + 1
  
      Loop Until negativeRow &gt;= LastRow
  
      Application.DisplayAlerts = False
  
  'Compensated Items Counting - add ID VBA code to make it work
  
          CompensatedItems = Sheets("Compensated").Cells(20000, 15).End(xlUp).Value
  
          MsgBox CompensatedItems &amp; " Transactions Compensated", Title:="Bank Reconciliation Process (JMC)"
  
  
  End Sub
  </code></pre>
  
  <p>This is the Second Macro that will be doing practically the same just move one variable O= O + 1 that will impact in "negative" variable.</p>
  
  <pre><code>Sub SecondItinerationSearchForCompensation()
  
  Dim CompensatedItems As Currency
  m = 1
  o = 2
  LastRow = Cells(20000, 6).End(xlUp).Row
  
          Do
          LastRow = Cells(20000, 6).End(xlUp).Row
          Application.DisplayAlerts = False
  
          positive = Cells(2, 7).Offset(m, 0).Value
          negative = Cells(2, 7).Offset(o, 0).Value
          positiveRow = Cells(2, 7).Offset(m, 0).Row
          negativeRow = Cells(2, 7).Offset(o, 0).Row
  
          If positive + negative = 0 Then
  
  'Highlight Compensated Items
  
          Cells(positiveRow, 7).Interior.Color = rgbLightBlue
          Cells(negativeRow, 7).Interior.Color = rgbLightBlue
          Cells(positiveRow, 7).Offset(0, 2).Value = "Compensated"
          Cells(negativeRow, 7).Offset(0, 2).Value = "Compensated"
  
  'Filter by Color
  
          ActiveSheet.Range("$A$2:$N$25").AutoFilter Field:=7, Criteria1:=RGB(173, _
              216, 230), Operator:=xlFilterCellColor
  
  'Select Range
  
          Range("A2").Select
          Range(Selection, Selection.End(xlToRight)).Select
          Range(Selection, Selection.End(xlDown)).Select
  
  'Copy to the "Compensated" Sheet
  
          Selection.Copy
          Sheets("Compensated").Select
          Cells(20000, 1).End(xlUp).Offset(2, 0).Select
          ActiveSheet.Paste
          Sheets("Pending Items").Select
  
  'Delete Lines from "Pending Items" sheet
  
          Range("A" &amp; positiveRow).Delete
          Range("A" &amp; (negativeRow) - 1).Delete
  
          ActiveSheet.ShowAllData
  
          o = 1
  
          Else
  
  'Last Loop should be add to move from m position
  
           'm = m + 1 check where I should add this 
  
          End If
  
          o = o + 1
  
  'It's where the macro will compensate - should be "positive" variable as it it the first amount checked from the top
  
          Loop Until negativeRow &gt;= LastRow
  
      Application.DisplayAlerts = False
  
      'Compensated Items Counting - add Counter Items "ID" code to make it work
  
  
      CompensatedItems = Sheets("Compensated").Cells(20000, 15).End(xlUp).Value
  
      MsgBox CompensatedItems &amp; " Transactions Compensated - Please Check Compensated Sheet", Title:="Bank Reconciliation Process (JMC)"
  
      End Sub
  </code></pre>
  
  <p>1.The macro is highlighting the first two items if they sum is zero, (that works very well when "positive" and "negative" variables net zero), then the macro move the items to the "Compensated" sheet succesfully and delete them from the "Pending Items" sheet (no longer need them).</p>
  
  <p>2.The second macro works when the "positive" and "negative" variables is not summing zero and then the macro will look for the next variable for "negative" variable to net to zero the "positive" variable.</p>
  
  <p>What I need is the code to move the variable "positive" when the variable "negative" reaches the last row (as it has no matching it's ok if the variable goes to the second row to re do the proces) In other case I'll need Do Loops as many rows as I have.. and is not the intention.</p>
  
  <p>If you can help me to reduce the code and fix the macro would be great... I'm just 3 months wisdom on VBA.</p>