VBA - compare list without duplicate

[PeterB1988]

Hi,
I have been working on a VBA code for the last week or so and can get about 5% away from the result that I require.

I have 2 worksheets:

Sheet1 - which has a list of data in E:E
Sheet2 - which has a list of data in G2:G
Both lists have matching values in the list.

What I am trying to do is check if each cell in sheet1 is in sheet2, if it is then copy and paste the data from that row into the relative row of sheet2's matched value. This bit I can do........Where I am struggling is when I have a single value in sheet1 but multiple values in sheet2. I only want to copy and paste the data across in one match but it will copy and paste the info across to both matches. Similarly if I have 2 values in sheet1 but only one value in sheet2 it overwrites the information.

Below I have shown the code I am using.

Sub FillinAlegs()

Application.ScreenUpdating = False
Dim names As Range, name As Range, values As Range, value As Range, rng As Range



Set values = Worksheets("Sheet1").Range("E1:E" & Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row) '
Set names = Worksheets("Sheet2").Range("G2:G" & Worksheets("Sheet2").Range("G" & Rows.Count).End(xlUp).Row) '

For Each name In names
For Each value In values
If value.value = name.value Then
Worksheets("Sheet1").Range("A" & value.Row & ":P" & value.Row).Copy Destination:=Worksheets("Sheet2").Range("C" & name.Row & ":R" & name.Row)
End If
Next value
Next name

Application.ScreenUpdating = True

End Sub

Please help me. I am pulling my hair out!

Thanks

 

[ttray33y]

Hi,
I have been working on a VBA code for the last week or so and can get about 5% away from the result that I require.

I have 2 worksheets:

Sheet1 - which has a list of data in E:E
Sheet2 - which has a list of data in G2:G
Both lists have matching values in the list.

What I am trying to do is check if each cell in sheet1 is in sheet2, if it is then copy and paste the data from that row into the relative row of sheet2's matched value. This bit I can do........Where I am struggling is when I have a single value in sheet1 but multiple values in sheet2. I only want to copy and paste the data across in one match but it will copy and paste the info across to both matches. Similarly if I have 2 values in sheet1 but only one value in sheet2 it overwrites the information.

Below I have shown the code I am using.



Please help me. I am pulling my hair out!

Thanks

I would suggest using DICTIONARY.

 

[Fluff]

How about

Sub CopyCompare()
   Dim Cl As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet

Application.ScreenUpdating = False
   Set Ws1 = Sheets("Pcode")
   Set Ws2 = Sheets("Sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("E1", Ws1.Range("E" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, -4).Resize(, 16)
      Next Cl
      For Each Cl In Ws2.Range("G2", Ws2.Range("G" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            .Item(Cl.Value).Copy Cl.Offset(, -4)
            .Remove (Cl.Value)
         End If
      Next Cl
   End With
End Sub

 

[PeterB1988]

HI Fluff, that code seems to have the same problems as my code. The issue is when there is a duplicate in E:E. It only copies the first duplicated value across to sheet2. At least yours doesn't overwrite the data which is great. If it helps with a solution; although column E:E will have duplicates, the data in column B:B wont be the same for them

Below is sheet1 - columns A-P

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

A

1

06:00

06:45

BlueCar

A Leg

Garage

Y

N

Y

Y

Y

N

N

AB

CD

A

2

06:00

06:45

BlueCar

A Leg

Garage

N

Y

N

N

N

N

N

AB

CD

A

3

06:00

06:45

BlueCar

A Leg

Garage

N

N

N

N

N

Y

N

AB

CD

<tbody>
</tbody>

Below is sheet 2 - the output of your code - columns C-R

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

A

1

06:00

06:45

BlueCar

A Leg

Garage

Y

N

Y

Y

Y

N

N

AB

CD

BlueCar

BlueCar

<tbody>
</tbody>

Below is the desired outcome - there are 5 BlueCars in the sheet2 so the 3 from sheet1 will be pasted in and then leave the other 2 blank.

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

A

1

06:00

06:45

BlueCar

A Leg

Garage

Y

N

Y

Y

Y

N

N

AB

CD

A

2

06:00

06:45

BlueCar

A Leg

Garage

N

Y

N

N

N

N

N

AB

CD

A

3

06:00

06:45

BlueCar

A Leg

Garage

N

N

N

N

N

Y

N

AB

CD

BlueCar

BlueCar

<tbody>
</tbody>

 

[Fluff]

Ok,how about

Sub CopyCompare()
   Dim Cl As Range
   Dim ValU As String
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet

Application.ScreenUpdating = False
   Set Ws1 = Sheets("Pcode")
   Set Ws2 = Sheets("Sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("E1", Ws1.Range("E" & Rows.Count).End(xlUp))
         ValU = Cl.Value & "|" & Cl.Offset(, 3).Value
         If Not .exists(ValU) Then .Add ValU, Cl.Offset(, -4).Resize(, 16)
      Next Cl
      For Each Cl In Ws2.Range("G2", Ws2.Range("G" & Rows.Count).End(xlUp))
         ValU = Cl.Value & "|" & Cl.Offset(, 3).Value
         If .exists(ValU) Then
            .Item(ValU).Copy Cl.Offset(, -4)
            .Remove (ValU)
         End If
      Next Cl
   End With
End Sub