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]

The position of the sheets does not matter, as long as the names are Sheet1, sheet2, sheet3 and sheet4; and of course, correspond to the structure:

So i want to copy and paste a row which is the same in sheet1 and sheet2, ... Sheet3 ...sheet4

So the macro already works. Or what problem do you have.
It is not enough to say: "I get an error".
You must say, what is the error message, on which line the macro stops, what are the names of your sheets, what are the data you are testing with and what is the result you want.

 

[RandomUserCode]

The position of the sheets does not matter, as long as the names are Sheet1, sheet2, sheet3 and sheet4; and of course, correspond to the structure:


So the macro already works. Or what problem do you have.
It is not enough to say: "I get an error".
You must say, what is the error message, on which line the macro stops, what are the names of your sheets, what are the data you are testing with and what is the result you want.

The error is still "Application-defined or object-defined error" and it's in the last line: Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d

 

[DanteAmor]

That's because there are no differences to save on sheet4.
You should at least try a "dummy" scenario where you have a difference to put information on sheet4.
I've been asking you since post #4.

The correction is very simple, use the following:

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
  If k > 0 Then Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
  If m > 0 Then Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d
End Sub

 

[RandomUserCode]

That's because there are no differences to save on sheet4.
You should at least try a "dummy" scenario where you have a difference to put information on sheet4.
I've been asking you since post #4.

View attachment 45546


The correction is very simple, use the following:

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
  If k > 0 Then Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
  If m > 0 Then Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d
End Sub

As i said before i cant give a complete example as im not allowed to share that data with you. But the two sheets i sent pictures of is the same format, so there shouldn't be an issue?

 

[DanteAmor]

Do not share it, only you take the test.
You tried the last macro from post #13.
Do you still have problems?
What does the error say?
In which line does the error appear?
Try generic data.
You do not have to put your confidential data here, in fact, the tests I do are with generic data.
So, I invite you to change your confidential data for generic data and perform the tests for the macro to write on sheets 3 and 4.

 

[RandomUserCode]

Do not share it, only you take the test.
You tried the last macro from post #13.
Do you still have problems?
What does the error say?
In which line does the error appear?
Try generic data.
You do not have to put your confidential data here, in fact, the tests I do are with generic data.
So, I invite you to change your confidential data for generic data and perform the tests for the macro to write on sheets 3 and 4.

Okay sry i misunderstood, will test it tomorrow! Thank you so much for all the work you have made so far, hope you can help me to get finished

 

[RandomUserCode]

Okay sry i misunderstood, will test it tomorrow! Thank you so much for all the work you have made so far, hope you can help me to get finished

Okay so it fails in the last line

when i hover over End(3) (2), its says "a(i,5) = <subscribt out of range>"
It says my row count is 1048576, although i got 4 rows in sheet1 and 4 in sheet2. Is that the reason why it says subscribt out of range?

Does this help or?

 

[DanteAmor]

Does this help or?

No, that doesn't help.
First, you are not testing with the macro that I put you in post #13
Second, I don't know what data you are testing with.
Third, By the way, do you have a sheet called "Sheet4"?

I only asked you to do a test with generic data and to help us by putting that generic data here, to see what problem you have.

This is what I mean by testing with generic data

 

[RandomUserCode]

Sheet1 (generic data):

Sheet2 (generic data):

And yeah its the code from answer 13 that makes this output to sheet3 and sheet4 (i got a sheet called sheet4 yes)

Output sheet3 (the ones that match completely):

Output sheet4 (the ones that match on everything but amount, and then state the difference):

And this is the code im using:

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
  If k > 0 Then Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
  If m > 0 Then Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d
End Sub

 

[RandomUserCode]

Sheet1 (generic data):
View attachment 46114


Sheet2 (generic data):
View attachment 46115

And yeah its the code from answer 13 that makes this output to sheet3 and sheet4 (i got a sheet called sheet4 yes)

Output sheet3 (the ones that match completely):View attachment 46116

Output sheet4 (the ones that match on everything but amount, and then state the difference):View attachment 46117

And this is the code im using:

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
  If k > 0 Then Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
  If m > 0 Then Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d
End Sub

And if i change the amount in row 3, 4 and 5 (so row 2 is the only one that matches), then row 2 gets copied to sheet3 as intended but in sheet4 the only difference shown is the row 5. What happens with row 2 and row 3? Why don't they show in sheet4 if there is an amount difference?