See, If it helps you..
To run this macro you need to take care that you have two sheets.
Private Sub extractunique()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim irs1 As Integer
Dim ics1 As Integer
Dim irs2 As Integer
Dim ics2 As Integer
Dim intcomp As Integer
Dim i2 As Integer
Dim i As Integer
Dim sht As Worksheet
Dim flag As Boolean
Dim flag2 As Boolean
Dim inttotalcolumn As Integer
' You need to take care that you have two sheets
Set s1 = Sheet1
Set s2 = Sheet2
For Each sht In Worksheets
If sht.Name = "Extract" Then
flag2 = True
End If
Next sht
If flag2 = False Then
Sheets.Add.Name = "Extract"
End If
'Call clearmarks
Worksheets("Extract").Cells.Clear
irs1 = s1.[a1].CurrentRegion.Rows.Count
ics1 = s1.[a1].CurrentRegion.Columns.Count
irs2 = s2.[a1].CurrentRegion.Rows.Count
ics2 = s2.[a1].CurrentRegion.Columns.Count
If ics1 <> ics2 Then
MsgBox "You Dont Have Equal Columns."
Exit Sub
Else
inttotalcolumn = ics1
End If
For irs1 = 2 To irs1
If irs1 = 4 Then
Debug.Print irs1
End If
flag = True
i2 = 0
For i2 = 2 To irs2
For i = 1 To ics1
If s1.Cells(irs1, i).Value <> s2.Cells(i2, i).Value Then
GoTo label1
End If
If s1.Cells(irs1, i).Value = s2.Cells(i2, i).Value And flag = True Then
intcomp = 1 + intcomp
End If
Next i
i = i - 1
' put the condition according to your columns
' you can have 2 or 3 or 4. Here we have compare
' 11 columns.so intcomp = 11.
If intcomp = inttotalcolumn Then
flag = False
' Worksheets("Extract").Range("a1").SpecialCells(xlCellTypeLastCell).Offset(1, 0).Select
Worksheets("Extract").Select
[a1].Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
' Here you need to change the cells(irs1,11) to number of
' column you compare.
s1.Range(Cells(irs1, 1).Address, Cells(irs1, 11).Address).Copy ActiveCell
' if you want to remove the row from the sheet1
's1.Range(Cells(irs1, 1).Address, Cells(irs1, 11).Address).Delete
End If
i = 0
intcomp = 0
s1.Select
label1:
intcomp = 0
Next i2
Next irs1
Worksheets("Extract").Select
End Sub
ni****h desai
http://www.pexcel.com
