Macro, match cell from 4 columns, copy matched to sheet 2, delete matched of sheet 1.

[freerskys]

My Project continues, thanks go out to Zot and bebo021999 for previous help.

This Address book consists of, Sheet 1 has 3K rows, Sheet 2 has 50K rows.

Sheet 1, column A, consist of First Names (could include more than one name in a cell: A,B,C or just A), column B consist of Last Names, column C consist of Street Numbers and column D consist of Street Names.

Sheet 2 has the same configuration as Sheet 1.

If Sheet 1 row 1, Column B, Cell A, Does NOT Match Sheet 2 Column B, Cell A any row, do the loop dance, go to Sheet 1 row 2.

If in Sheet 1, Row 2, Column B matches Sheet 2 Column B any row, only then, if Sheet 1 Column C matches Sheet 2 Column C same row, only then, if Sheet 1 Column D matches Sheet 2 Column D same row,

If at any time there is no match, check the next row.

Copy, Sheet 1 matched entire row to Sheet 3, delete Sheet 1 matched entire row. Does this till the end of file.

Thank you, for any assistance.

 

[DanteAmor]

column A, consist of First Names (could include more than one name in a cell: A,B,C or just A)

If Sheet 1 row 1, Column B, Cell A

That's a bit confusing to me.

Could you put some examples of sheet 1 and sheet 2.
Use generic data, you don't need to put real data.
To put the examples in the post, use the XL2BB minisheet tool.
Something like this:

Libro2
	A	B	C	D	E	F
1	First Name	Last Name	Street Number	Street Name
2	John	Smith	123	salsipue		<--- Match
3	Bill	Wood	456	rocallo		<--- No match
4	etc	etclast	999	whatever		<--- No match
Sheet1

Libro2
	A	B	C	D
1	First Name	Last Name	Street Number	Street Name
2	John	Smith	123	salsipue
3
Sheet2

Result on sheet3:

Libro2
	A	B	C	D
1	First Name	Last Name	Street Number	Street Name
2	John	Smith	123	salsipue
3
Sheet3

 

[freerskys]

Hi DanteAmor, that's exactly what I'm looking for. can you please help me with that.
Thanks.

 

[freerskys]

Someone, please help.
Thanks.

 

[DanteAmor]

Sheet 1, column A, consist of First Names (could include more than one name in a cell: A,B,C or just A), column B consist of Last Names, column C consist of Street Numbers and column D consist of Street Names.
Sheet 2 has the same configuration as Sheet 1.
If Sheet 1 row 1, Column B, Cell A, Does NOT Match Sheet 2 Column B, Cell A any row, do the loop dance, go to Sheet 1 row 2.
If in Sheet 1, Row 2, Column B matches Sheet 2 Column B any row, only then, if Sheet 1 Column C matches Sheet 2 Column C same row, only then, if Sheet 1 Column D matches Sheet 2 Column D same row,

I'd be glad to help you, but it would be great if you put a complete example of the possible scenarios, records to copy and records not to copy.
My examples are only to demonstrate how to use the XL2BB minisheet tool.
Remember, you are asking us for help, so help us by providing the information for the completed examples.

 

[freerskys]

Thanks DanteAmor
I hope this is alright.

Book1
	A	B	C	D	E	F	G
4
5	First Name	Last Name	Street Number	Street Name
6	John	Smith	123	salsipue		<--- Match
7	Bill	Wood	456	rocallo		<--- No match
8	etc	etclast	999	whatever		<--- No match
9	John Don Bob	Revi	63	Somewhere		<--- Match
10	Sheet1
11
12
13	First Name	Last Name	Street Number	Street Name
14	John	Smith	123	salsipue
15	John Don Bob	Revi	63	Somewhere
16	Sheet2
17
18
19	First Name	Last Name	Street Number	Street Name
20	John	Smith	123	salsipue
21	John Don Bob	Revi	63	Somewhere
22	Sheet3
Sheet1

 

[DanteAmor]

Try this:

Sub CopyAndDelete()
  Dim sh1 As Worksheet
  Dim dic As Object
  Dim rng As Range
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long
 
  Set sh1 = Sheets("Sheet1")
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
 
  a = sh1.Range("A2:D" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  b = Sheets("Sheet2").Range("A2:D" & Sheets("Sheet2").Range("A" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1), 1 To 4)
 
  For i = 1 To UBound(b, 1)
    dic(b(i, 1) & "|" & b(i, 2) & "|" & b(i, 3) & "|" & b(i, 4)) = Empty
  Next
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4)) Then
      j = j + 1
      c(j, 1) = a(i, 1)
      c(j, 2) = a(i, 2)
      c(j, 3) = a(i, 3)
      c(j, 4) = a(i, 4)
      If rng Is Nothing Then Set rng = sh1.Range("A" & i) Else Set rng = Union(rng, sh1.Range("A" & i))
    End If
  Next
  If j > 0 Then Sheets("Sheet3").Range("A2").Resize(j, 4).Value = c
  If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub

 

[freerskys]

Try this:

Sub CopyAndDelete()
  Dim sh1 As Worksheet
  Dim dic As Object
  Dim rng As Range
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long
 
  Set sh1 = Sheets("Sheet1")
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
 
  a = sh1.Range("A2:D" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  b = Sheets("Sheet2").Range("A2:D" & Sheets("Sheet2").Range("A" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1), 1 To 4)
 
  For i = 1 To UBound(b, 1)
    dic(b(i, 1) & "|" & b(i, 2) & "|" & b(i, 3) & "|" & b(i, 4)) = Empty
  Next
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4)) Then
      j = j + 1
      c(j, 1) = a(i, 1)
      c(j, 2) = a(i, 2)
      c(j, 3) = a(i, 3)
      c(j, 4) = a(i, 4)
      If rng Is Nothing Then Set rng = sh1.Range("A" & i) Else Set rng = Union(rng, sh1.Range("A" & i))
    End If
  Next
  If j > 0 Then Sheets("Sheet3").Range("A2").Resize(j, 4).Value = c
  If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub

Of course it works, your a Pro.
Is it possible, to add a way , if First name Sheet 2, had only Bob, Sheet 1 still had everything the same John Don Bob, that would be a match.

 

[freerskys]

Is there a way to copy the complete row to Sheet 3, instead of just the 4 cells?