title: Excel VBA Automated Reconciliation
body: <p>I have an excel worksheet set up as shown below which lists two types of transactions - Advance Pmt Credit &amp; Refill. The objective is to reconcile this and ensure that each Advance Pmt Credit is offset by a group of Refills. </p>
  
  <pre><code>Date    Description  Amount     Grouping    AutoRef Sum Check   Ref Chk
  12/7/2012   Refill   (20,000.00)    advpmtcrdt1     0   Ok
  12/7/2012   Advance Pmt Credit   20,000.00  advpmtcrdt1 advpmtcrdt1 0   Ok
  12/9/2012   Refill   (20,000.00)    advpmtcrdt2     0   Ok
  12/9/2012   Refill   (40,000.00)    advpmtcrdt2     0   Ok
  12/10/2012  Refill   (20,000.00)    advpmtcrdt2     0   Ok
  12/10/2012  Advance Pmt Credit   80,000.00  advpmtcrdt2 advpmtcrdt2 0   Ok
  12/11/2012  Refill   (40,000.00)    advpmtcrdt4     -100000 Ok
  12/11/2012  Refill   (40,000.00)    advpmtcrdt4     -100000 Ok
  12/11/2012  Refill   (20,000.00)    advpmtcrdt3     0   Ok
  12/11/2012  Advance Pmt Credit   20,000.00  advpmtcrdt3 advpmtcrdt3 0   Ok
  12/12/2012  Refill   (20,000.00)    advpmtcrdt4     -100000 Ok
  </code></pre>
  
  <p>The actual data runs from column 1 to column 3; i use column 4 to assign each record to a group; column 5 has formula to assign each Advance Pmt Credit a numbered ref; column 6 &amp; 7 has some checks to ensure that each group adds to 0 and only 1 Advance Pmt Credit exists in a group.</p>
  
  <p>I need to group the rows by adding a reference in column 4 (Grouping) such that</p>
  
  <ol>
  <li>the total of each group should be 0</li>
  <li>Each group can contain only one 'Advance Pmt Credit'</li>
  <li>Rule 2 implies that value in col 4 should be same as the reference in col 5, if it is an Advance Pmt Credit.</li>
  </ol>
  
  <p>I tried to write a macro to add the references in col 4 automatically:</p>
  
  <pre><code>Sub AutoFill()
  
  Dim Ref As String
  Dim rng As Range
  
  
  Application.ScreenUpdating = False
  With Application.WorksheetFunction
  
  On Error Resume Next
  Ref = .VLookup("Unresolved", Range("FullList"), 3, 0)
  If Err.Number = "1004" Then Ref = .VLookup("Free", Range("List"), 2, 0)
  
  While .Index(Range("AB:AC"), .Match(Ref, Range("AB:AB"), 0), 1) &lt;&gt; Ok
  
      On Error Resume Next
      Ref = .VLookup("Unresolved", Range("FullList"), 3, 0)
      If Err.Number = "1004" Then Ref = .VLookup("Free", Range("List"), 2, 0)
  
      .Index(Range("N:O"), .Match(Ref, Range("O:O"), 0), 1) = Ref
  
      Set rng = Range("N1").End(xlDown).Offset(1, 0)
  
          While .SumIf(Range("N:N"), Ref, Range("L:L")) &lt;&gt; 0
          If .CountA(rng) = 0 Then
          rng.Value = Ref
          If .Sum(Range("P:P")) &lt; 0 Then rng.Clear
          End If
          Set rng = rng.Offset(1, 0)
          Wend
  Wend
  
  End With
  
  Application.ScreenUpdating = True
  End Sub
  </code></pre>
  
  <p>This is what the macro does: check the next unused ref, assign it in col 4 according to rule 3 given above, then start assigning the same ref to the first available blank cells in col 4 utill the sum of the group is 0; if the sum of Refills goes more than the Advance Pmt credit amount, then delete the last updated ref; then find the next available empty cell in col 3 and add the ref; then check the sum again...repeat these steps until all items are balanced. </p>
  
  <p><strong>Problem:</strong> The macro ran smooth till it made some 15 groups but eneterd an infinite loop in the 16th iteration. This logic fails if the sum of refills exceeds the Advance Pmt credit total after we add a refill to the group. I have uploaded the workbook <a href="https://drive.google.com/file/d/0B-wCR0PXhVQSLUJzbWplZ2hRZms/edit?usp=sharing" rel="nofollow">here</a>.</p>
  
  <p>Can you suggest a better algorithm to achieve this - with or without VBA.</p>
  
  <p>Appreciate your help &amp; suggestions!</p>