Match rows for value in specific columns and paste matched/unmatched rows in new sheet

[RandomUserCode]

I got data in sheet1 and sheet2, which i want to copy and paste in sheet3. That is already done. So next i want to match rows, by checking column C, D, E, H and I. The C and H column value is integer and the rest is text/strings.

If two rows match, then i want to copy and paste one of the lines in a new third sheet, and add the integer difference from column H in column H (The difference will be 0 if the lines match in all columns)

If the two rows dont match, copy and paste one of the lines in a new fourth sheet, and add the integer difference from column H in column H

The code so far:

    Sub CopyPasteSheet()

        Dim mySheet, arr
    
        arr = Array("Sheet1", "Sheet2")
        Const targetSheet = "Sheet3"
    
        Application.ScreenUpdating = False
    
        For Each mySheet In arr
            Sheets(mySheet).Range("A1").CurrentRegion.Copy
                With Sheets(targetSheet)
                    .Range("A1").Insert Shift:=xlDown
                    If mySheet <> arr(UBound(arr)) Then .Rows(1).Delete xlUp
                End With
        Next mySheet
    
        Application.ScreenUpdating = True
    
    End Sub

 

[DanteAmor]

You can put a sample of your data from sheet1 and sheet2. Ande the desired results on sheet3 and sheet4.
Use the XL2BB tool minisheet.

 

[RandomUserCode]

You can put a sample of your data from sheet1 and sheet2. Ande the desired results on sheet3 and sheet4.
Use the XL2BB tool minisheet.

I took a picture of sheet1 and one of sheet2. Had to change some as i cant show that here. Well i want to check if a row in sheet1 matches in the specific columns, a row in sheet2. So i want to copy and paste a row which is the same in sheet1 and sheet2, in sheet3. Sheet3 should be the sheet where every column macthes and sheet4 should be the sheet where every column but the amount column H matches. And in sheet4 when the row have been copied/pasted, then a new column with the difference between the amounts is stated. Does that make sense, if it doesnt let me know so i can try to rephrase Thanks in advance and thanks for taking time to reply!

 

[DanteAmor]

So i want to copy and paste a row which is the same in sheet1 and sheet2, in sheet3. Sheet3 should be the sheet where every column macthes

That is pretty clear to me.

sheet4 should be the sheet where every column but the amount column H matches.

What about the records where the data does not match?


In your example, only the first record matches the data, and since the quantity is equal, then it is copied to sheet3.
The other records do not match, so sheet4 will be empty.

You can put at least one record to copy to sheet4, and how to calculate the difference. Amount-Sheet1 minus Amount-Sheet2 or Amount-Sheet2 minus Amount-Sheet1.

 

[RandomUserCode]

That is pretty clear to me.


What about the records where the data does not match?


In your example, only the first record matches the data, and since the quantity is equal, then it is copied to sheet3.
The other records do not match, so sheet4 will be empty.

View attachment 45273

You can put at least one record to copy to sheet4, and how to calculate the difference. Amount-Sheet1 minus Amount-Sheet2 or Amount-Sheet2 minus Amount-Sheet1.

Yeah so in that example the first row is the only row to match between sheet1 and sheet2. So correct, sheet4 will be empty in this case because there isnt a row in sheet1 and sheet2 where all columns except the amount column that matches. Sheet3 would just be row 1 copied and pasted into first available row in sheet3, and then the amount column overwrited to a difference column, which is 0 in sheet3. In sheet4 a difference column is again needed instead of the amount column. Is it somehow possible to make that?

 

[DanteAmor]

You can put at least one record to copy to sheet4

You could give a complete example.

 

[DanteAmor]

Try this:

Sub MatchRows()
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long
  Dim dic As Object, ky As String
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Sheets("Sheet1").Range("A1:I" & Sheets("Sheet1").Range("H" & Rows.Count).End(3).Row).Value
  b = Sheets("Sheet2").Range("A1:I" & Sheets("Sheet2").Range("H" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  ReDim d(1 To UBound(a, 1), 1 To UBound(a, 2))
  
  For i = 1 To UBound(b, 1)
    ky = b(i, 3) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 9)
    dic(ky) = i
  Next
  
  For i = 2 To UBound(a, 1)
    ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 9)
    If dic.exists(ky) Then
      j = dic(ky)
      If a(i, 8) = b(j, 8) Then
        k = k + 1
        For n = 1 To UBound(a, 2)
          c(k, n) = a(i, n)
        Next
        c(k, 8) = 0
      Else
        m = m + 1
        For n = 1 To UBound(a, 2)
          d(k, n) = a(i, n)
        Next
        d(k, 8) = a(i, 8) - b(j, 8)
      End If
    End If
  Next
  
  Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
  Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d
End Sub

 

[RandomUserCode]

Try this:

Sub MatchRows()
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long
  Dim dic As Object, ky As String
 
  Set dic = CreateObject("Scripting.Dictionary")
  a = Sheets("Sheet1").Range("A1:I" & Sheets("Sheet1").Range("H" & Rows.Count).End(3).Row).Value
  b = Sheets("Sheet2").Range("A1:I" & Sheets("Sheet2").Range("H" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  ReDim d(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  For i = 1 To UBound(b, 1)
    ky = b(i, 3) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 9)
    dic(ky) = i
  Next
 
  For i = 2 To UBound(a, 1)
    ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 9)
    If dic.exists(ky) Then
      j = dic(ky)
      If a(i, 8) = b(j, 8) Then
        k = k + 1
        For n = 1 To UBound(a, 2)
          c(k, n) = a(i, n)
        Next
        c(k, 8) = 0
      Else
        m = m + 1
        For n = 1 To UBound(a, 2)
          d(k, n) = a(i, n)
        Next
        d(k, 8) = a(i, 8) - b(j, 8)
      End If
    End If
  Next
 
  Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
  Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d
End Sub

Holy moly it almost works. I get an error "Application-defined or object-defined error". It does copy the rows which match into a new sheet and state the difference as 0 in column H, but it doesn't work for the ones that dont match

 

[DanteAmor]

When the error occurs, you can press the Debug button and tell me which macro line is highlighted in yellow.
Also put here the sample of data you are testing with, to check what problem you have with your data.

 

[RandomUserCode]

When the error occurs, you can press the Debug button and tell me which macro line is highlighted in yellow.
Also put here the sample of data you are testing with, to check what problem you have with your data.

Okay maybe its because my fourth sheet is named sheet3 and my fifth sheet is named sheet4. Can it be about the placement, because i made a new file, had my data in sheet1 (1) and sheet2 (2). Then i perfectly copied and stated the difference i column H