Excel, comparing two sets of two rows [Solved/Closed]

Posts
4
Registration date
Friday August 31, 2012
Last seen
September 11, 2012
- - Latest reply: Sanzer
Posts
4
Registration date
Friday August 31, 2012
Last seen
September 11, 2012
- Sep 6, 2012 at 10:32 AM
Hello,

I know the title may be a little confusing, and I apologize for that, but I really did not know how to phrase it. What I have is two Excel worksheets within the same workbook, I have a macro that the individuals from this board assisted me with so graciously back in April that looks at a row in each worksheet and creates another sheet displaying the information that is duplicated between them. What I am looking to do is make it do this twice, looking at the original cells for duplicates, then refining this by looked at a further two cells in the respective sheets to weed out and conflicts.

Example would be
WS1!Col A WS1!Col B WS2!Col A WS2!Col B
1 1 1 1
1 2 1 3
2 1 2 1
2 3 2 4


Output...
WS3!Col A WS3!Col B
1 1
2 1

Below is the code used for the original macro, and it works stupendously for its intended workbook. I just cannot wrap my head around how to make it look at another set of columns without getting stuck in a loop (I've tried a couple tweaks to this code unsuccessfully). If anyone could possibly give me a hint or something that will set me on the right track; I feel as though the solution is just beyond my fingertips.

Thank you in advance for any assistance you are able to render me.

Sub CompareExpendables()
'This macro checks all of the cells in one column on sheet 1(expendables)
'against one column on sheet 2(on hand inventory) and creates a new sheet
'showing all of the items that appear on both.
'Credit to Kioskea users for assisting in the creation of this macro

Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1row As Integer
    Dim sh2row As Integer
    Dim sh1col As Integer
    Dim sh2col As Integer
    Dim rng1ct As Range
    Dim rng2ct As Range
    Dim row1 As Range
    Dim row2 As Range
    Dim lastRow As Long
    Dim i As Integer
        
    Set sh1 = ActiveWorkbook.Sheets(1)
    Set sh2 = ActiveWorkbook.Sheets(2)
    sh1row = sh1.Range("a" & Rows.Count).End(xlUp).Row
    sh1col = sh1.Range("a" & Columns.Count).End(xlToLeft).Column
    Set rng1ct = sh1.Range("a2").Resize(sh1row, sh1col)
    sh2row = sh2.Range("b" & Rows.Count).End(xlUp).Row
    sh2col = sh2.Range("b" & Columns.Count).End(xlToLeft).Column
    Set rng2ct = sh2.Range("b3").Resize(sh2row, sh2col)
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    sh2.Range("a2:l2").Copy Destination:=Worksheets(3).Range("a1:l1")
       
     With Worksheets(3)
        .AutoFilterMode = False
        .Range("A1:L1").AutoFilter
    End With
    
    For Each row1 In rng1ct
        For Each row2 In rng2ct
            If row2 = row1 Then
                row2.EntireRow.Copy Destination:=Worksheets(3).Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
        Next row2
    Next row1
    
    lastRow = Range("K" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        If Range("K" & i) = "" Then Exit For
        If Range("K" & i).Value = 0 Then
        Range("K" & i).EntireRow.Delete
        i = i - 1
        End If
    Next i
        
    Worksheets(3).Range("A2:L2").Select
        Selection.EntireColumn.AutoFit
    Worksheets(3).Columns("E:H").ColumnWidth = 0
    
End Sub


See more 

1 reply

Posts
4
Registration date
Friday August 31, 2012
Last seen
September 11, 2012
0
Thank you
An update to the above question. I have gotten the macro to pick up the information I wanted it to, the only problem I'm having now is that its putting duplicate information onto the newly created work sheet. Please see underlined code for change made...

Sub CompareExpendables()
'This macro checks all of the cells in one column on sheet 1(expendables)
'against one column on sheet 2(on hand inventory) and creates a new sheet
'showing all of the items that appear on both.
'Credit to Kioskea users for assisting in the creation of this macro

Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh1row As Integer
    Dim sh2row As Integer
    Dim sh1col As Integer
    Dim sh2col As Integer
    Dim rng1ct As Range
    Dim rng2ct As Range
    Dim row1 As Range
    Dim row2 As Range
    Dim lastRow As Long
    Dim i As Integer
        
    Set sh1 = ActiveWorkbook.Sheets(1)
    Set sh2 = ActiveWorkbook.Sheets(2)
    sh1row = sh1.Range("a" & Rows.Count).End(xlUp).Row
    sh1col = sh1.Range("a" & Columns.Count).End(xlToLeft).Column
    Set rng1ct = sh1.Range("a2").Resize(sh1row, sh1col)
    sh2row = sh2.Range("b" & Rows.Count).End(xlUp).Row
    sh2col = sh2.Range("b" & Columns.Count).End(xlToLeft).Column
    Set rng2ct = sh2.Range("b3").Resize(sh2row, sh2col)
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    sh2.Range("a2:l2").Copy Destination:=Worksheets(3).Range("a1:l1")
       
     With Worksheets(3)
        .AutoFilterMode = False
        .Range("A1:L1").AutoFilter
    End With
    
    For Each row1 In rng1ct
        For Each row2 In rng2ct
            If row2 = row1 AND sh1.Range("D" & Rows.count) = sh2.Range("D" & Rows.count)_ Then
                row2.EntireRow.Copy Destination:=Worksheets(3).Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
        Next row2
    Next row1
    
    lastRow = Range("K" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        If Range("K" & i) = "" Then Exit For
        If Range("K" & i).Value = 0 Then
        Range("K" & i).EntireRow.Delete
        i = i - 1
        End If
    Next i
        
    Worksheets(3).Range("A2:L2").Select
        Selection.EntireColumn.AutoFit
    Worksheets(3).Columns("E:H").ColumnWidth = 0
    
End Sub



This change removed the extraneous data that we needed gone, but it is now post the correct data twice.