Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Excel List Comapre

4 views
Skip to first unread message

jang...@gmail.com

unread,
Mar 30, 2007, 10:44:30 AM3/30/07
to
I need to compare 2 list in Excel, and be able to generate a 3rd
worksheet which will have both the list side by side but will show
blank cells in either of the two list where the cell don't match, in
other words, the macro should move down the cells in either of the
list which don't match. To make it clear, the following link has the
excat macro that I want but its protected. Any help would be greatly
appreciated.

http://www.sharewareplaza.com/Excel-List-Compare-download_16416.html

merjet

unread,
Mar 30, 2007, 9:41:59 PM3/30/07
to
This will do the comparison. If you want more flexibility or a
UserForm, I leave it to you.

Sub CompareLists()
Dim iRow1 As Integer
Dim iRow2 As Integer
Dim iRow3 As Integer
Dim iTest1 As Long
Dim iTest2 As Long

iRow1 = 2
iRow2 = 2
iRow3 = 2
Do
If Sheet1.Cells(iRow1, 1) <> Sheet1.Cells(iRow2, 6) Or _
Sheet1.Cells(iRow1, 2) <> Sheet1.Cells(iRow2, 7) Then
Sheet2.Cells(iRow3, 5) = "No Match"
'If one list is longer than the other, will compare a number &
'a blank cell. The following is a work-around for a blank
cell.
If Sheet1.Cells(iRow1, 1) = "" Then
iTest1 = 100000000
Else
iTest1 = Sheet1.Cells(iRow1, 1)
End If
If Sheet1.Cells(iRow2, 6) = "" Then
iTest2 = 100000000
Else
iTest2 = Sheet1.Cells(iRow2, 6)
End If
If iTest1 < iTest2 Then
Sheet1.Range("A" & iRow1 & ":D" & iRow1).Copy
Sheet2.Range("A" & iRow3)
iRow1 = iRow1 + 1
Else
Sheet1.Range("F" & iRow2 & ":I" & iRow2).Copy
Sheet2.Range("F" & iRow3)
iRow2 = iRow2 + 1
End If
Else
Sheet1.Range("A" & iRow1 & ":D" & iRow1).Copy Sheet2.Range("A"
& iRow3)
Sheet1.Range("F" & iRow2 & ":I" & iRow2).Copy Sheet2.Range("F"
& iRow3)
iRow1 = iRow1 + 1
iRow2 = iRow2 + 1
End If
iRow3 = iRow3 + 1
Loop Until Sheet1.Range("A" & iRow1) = "" And Sheet1.Range("F" &
iRow2) = ""
End Sub

Hth,
Merjet


0 new messages