Compare 2 sheet and insert result into other
 

I have foglio1 (with index into col AC) and foglio2 (with index into co
AC) is possible to make a matching with this index and cut line fro
sheet and copy into foglio3:
Example:

first condition:
the index into sheet foglio1 col AC not is present in AC into foglio
delete the entire line (range A:AI) of sheet2 and insert int
sheet3...

second condition:
the line 3 and 4 from foglio1 not are present into foglio2 (index no
present into foglio2) add this line into foglio2, delete from foglio1

Into example wbook attached, delete the line 2 and 3 from foglio2 an
copy into foglio33
Into example wbook attached, copy the line 3 and 4 from foglio1 an
copy into sheet3, delete from foglio1



into real wbook the number of line about foglio1 and foglio2 i
15000...

+-------------------------------------------------------------------
|Filename: Cartel1.zip
|Download: http://www.excelforum.com/attachment.php?postid=4167
+-------------------------------------------------------------------

--
sal2

-----------------------------------------------------------------------
sal21's Profile: http://www.excelforum.com/member.php...nfo&userid=204
View this thread: http://www.excelforum.com/showthread.php?threadid=49714

Compare 2 sheet and insert result into other
 

Hi,

Try this (TEST data first!):

Sub compare()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim r as Long
Dim res as variant

Set ws1 = Worksheets("foglio1")
Set ws2 = Worksheets("foglio2")
Set ws3 = Worksheets("foglio3")

Set rng1 = ws1.Range("ac2:ac" & Cells(Rows.Count, "AC").End(xlUp).Row)
Set rng2 = ws2.Range("ac2:ac" & Cells(Rows.Count, "AC").End(xlUp).Row)
Set rng3 = ws3.Range("a2")

For r = rng1.Count To 1 Step -1
res = Application.Match(rng1(r), rng2, 0)
If IsError(res) Then
ws1.Rows(r + 1).EntireRow.Copy rng3
ws1.Rows(r + 1).EntireRow.Delete
Set rng3 = rng3.Offset(1, 0)
End If
Next r

' Reset rng1 as we have deleted rows ....

Set rng1 = ws1.Range("ac2:ac" & Cells(Rows.Count, "AC").End(xlUp).Row)

For r = rng2.Count To 1 Step -1
res = Application.Match(rng2(r), rng1, 0)
If IsError(res) Then
ws2.Rows(r + 1).EntireRow.Copy rng3
ws2.Rows(r + 1).EntireRow.Delete
Set rng3 = rng3.Offset(1, 0)
End If
Next r

End Sub

"sal21" wrote:


I have foglio1 (with index into col AC) and foglio2 (with index into col
AC) is possible to make a matching with this index and cut line fron
sheet and copy into foglio3:
Example:

first condition:
the index into sheet foglio1 col AC not is present in AC into foglio2
delete the entire line (range A:AI) of sheet2 and insert into
sheet3...

second condition:
the line 3 and 4 from foglio1 not are present into foglio2 (index not
present into foglio2) add this line into foglio2, delete from foglio1

Into example wbook attached, delete the line 2 and 3 from foglio2 and
copy into foglio33
Into example wbook attached, copy the line 3 and 4 from foglio1 and
copy into sheet3, delete from foglio1



into real wbook the number of line about foglio1 and foglio2 is
15000....


+-------------------------------------------------------------------+
|Filename: Cartel1.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4167 |
+-------------------------------------------------------------------+

--
sal21


------------------------------------------------------------------------
sal21's Profile: http://www.excelforum.com/member.php...fo&userid=2040
View this thread: http://www.excelforum.com/showthread...hreadid=497141

Compare 2 sheet and insert result into other
 

Toppers Wrote:
Hi,

Try this (TEST data first!):

Sub compare()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim r as Long
Dim res as variant

Set ws1 = Worksheets("foglio1")
Set ws2 = Worksheets("foglio2")
Set ws3 = Worksheets("foglio3")

Set rng1 = ws1.Range("ac2:ac" & Cells(Rows.Count, "AC").End(xlUp).Row)
Set rng2 = ws2.Range("ac2:ac" & Cells(Rows.Count, "AC").End(xlUp).Row)
Set rng3 = ws3.Range("a2")

For r = rng1.Count To 1 Step -1
res = Application.Match(rng1(r), rng2, 0)
If IsError(res) Then
ws1.Rows(r + 1).EntireRow.Copy rng3
ws1.Rows(r + 1).EntireRow.Delete
Set rng3 = rng3.Offset(1, 0)
End If
Next r

' Reset rng1 as we have deleted rows ....

Set rng1 = ws1.Range("ac2:ac" & Cells(Rows.Count, "AC").End(xlUp).Row)

For r = rng2.Count To 1 Step -1
res = Application.Match(rng2(r), rng1, 0)
If IsError(res) Then
ws2.Rows(r + 1).EntireRow.Copy rng3
ws2.Rows(r + 1).EntireRow.Delete
Set rng3 = rng3.Offset(1, 0)
End If
Next r

End Sub

"sal21" wrote:


I have foglio1 (with index into col AC) and foglio2 (with index int
col
AC) is possible to make a matching with this index and cut line fron
sheet and copy into foglio3:
Example:

first condition:
the index into sheet foglio1 col AC not is present in AC int
foglio2
delete the entire line (range A:AI) of sheet2 and insert into
sheet3...

second condition:
the line 3 and 4 from foglio1 not are present into foglio2 (inde
not
present into foglio2) add this line into foglio2, delete fro
foglio1

Into example wbook attached, delete the line 2 and 3 from foglio
and
copy into foglio33
Into example wbook attached, copy the line 3 and 4 from foglio1 and
copy into sheet3, delete from foglio1



into real wbook the number of line about foglio1 and foglio2 is
15000....



+-------------------------------------------------------------------+
|Filename: Cartel1.zip
|
|Download: http://www.excelforum.com/attachment.php?postid=4167
|

+-------------------------------------------------------------------+

--
sal21



------------------------------------------------------------------------
sal21's Profile
http://www.excelforum.com/member.php...fo&userid=2040
View this thread
http://www.excelforum.com/showthread...hreadid=497141



tks Toppers, i test it in my office tomorow....
After tell you...
Good New Year 2006

--
sal2

-----------------------------------------------------------------------
sal21's Profile: http://www.excelforum.com/member.php...nfo&userid=204
View this thread: http://www.excelforum.com/showthread.php?threadid=49714