Compare 2 sheet and insert result into other

S

sal21

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
+-------------------------------------------------------------------
 
T

Toppers

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
 
S

sal21

Toppers said:
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 said:
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 |

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

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top