Compare Amt between lines and move if matched

Hello NTB,

That was fun. It works on the data you posted, but the real test is with the actual data. Run this on a copy of the original workbook to check the results. I added a button on the Data sheet to run the macro. Here is the macro code...

Sub CopyMatches()

  Dim Amount As Currency
  Dim Cell As Range
  Dim DataWks As Worksheet
  Dim Docs As Object
  Dim DocNum As Variant
  Dim MatchWks As Worksheet
  Dim NextRow As Long
  Dim Rng As Range
  Dim RngEnd As Range
  
    Set DataWks = Worksheets("Data")
    Set MatchWks = Worksheets("Matched")
    
      Set Rng = DataWks.Range("A2")
      Set RngEnd = DataWks.Cells(Rows.Count, Rng.Column).End(xlUp)
      Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, DataWks.Range(Rng, RngEnd))
      
      NextRow = MatchWks.Cells(Rows.Count, "A").End(xlUp).Row
      NextRow = IIf(NextRow < 2, 2, NextRow + 1)
      
      Set Docs = CreateObject("Scripting.Dictionary")
      Docs.CompareMode = vbTextCompare
      
       'Sort the Data in ascending order by DocNum
        Rng.Resize(ColumnSize:=6).Sort Key1:=Rng.Cells(1, 1), Order1:=xlAscending, _
                                       Header:=xlYes, MatchCase:=False, _
                                       Orientation:=xlTopToBottom, _
                                       DataOption1:=xlSortTextAsNumbers
 
        For Each Cell In Rng
          DocNum = Cell.Text
          Amount = Cell.Offset(0, 5).Value
          DocType = Cell.Offset(0, 4).Text
          If Trim(DocNum) <> "" Then
            'Has DocNum be entered?
             If Not Docs.Exists(DocNum) Then
               'No - Check that the DocType is blank
                If DocType = "" Then
                   Docs.Add DocNum, Amount
                End If
             Else
               'Yes - Check that the DocType is "C" and the amounts equal zero
                If Cell.Offset(-1, 0) = DocNum And DocType = "C" Then
                   If Amount + Docs(DocNum) = 0 Then
                      'Copy the rows and clear the DocNum
                      Cell.Offset(-1, 0).Resize(2, 6).Copy MatchWks.Cells(NextRow, "A")
                      Cell.Offset(-1, 0).Resize(2, 1) = ""
                      NextRow = NextRow + 2
                   End If
                End If
             End If
          End If
        Next Cell
        
     'Delete the rows with no DocNum
      On Error Resume Next
      Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      
End Sub