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

RandomUserCode

New Member
Joined
Aug 4, 2021
Messages
19
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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:

VBA Code:
    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

Well-known Member
Joined
Dec 3, 2018
Messages
13,908
Office Version
  1. 2007
Platform
  1. Windows
My fault, try the following:

VBA Code:
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(m, n) = a(i, n)
        Next
        d(m, 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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

RandomUserCode

New Member
Joined
Aug 4, 2021
Messages
19
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
My fault, try the following:

VBA Code:
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(m, n) = a(i, n)
        Next
        d(m, 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
Yeah thanks a lot, found the error. 1 to UBound (a,2) for example, is how many rows it should look at in the array right? Like what if i want to look at line 4 to line 70. It can change from file to file which row the data starts in and which it stops at. So how can i change in the code so it looks at row 4 to row 70 for example?
 

RandomUserCode

New Member
Joined
Aug 4, 2021
Messages
19
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Yeah thanks a lot, found the error. 1 to UBound (a,2) for example, is how many rows it should look at in the array right? Like what if i want to look at line 4 to line 70. It can change from file to file which row the data starts in and which it stops at. So how can i change in the code so it looks at row 4 to row 70 for example?
Okay nevermind, found the mistake myself. So now i have a new file where there is values in sheet1 and sheet2 again. This time the rows it should look at is row 10 to row 100 and match with sheet2. This time the amount-column is in column G. And the columns it should look at is column A, B, C, D, F and G. How can i change the code so it fits the new file? Need to do it with 15 more files, so would be great to get like a "universal-file" so i only need to change with range and what columns to look at. Hope you can help me out again :)
 

Forum statistics

Threads
1,147,482
Messages
5,741,409
Members
423,657
Latest member
Medrok2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top