Match URLs and copy and paste from one sheet to another

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
858
Office Version
  1. 2016
Platform
  1. Windows
Hi.

Hope some one can help, I have been stuck on this for a few days and cant seem to work it out. I have a large list of customers and email address which i need to match from one sheet to another.

On sheet 1 Column A, I have URLS and in column B I have email addresses to those URLs. Not all Url have emails

On sheet 2 Column A, I have URLS and in column B I have email addresses to those URLs. Not all Url have emails

I need a VBA code that will do the following


  1. MATCH the urls from sheet 2 to sheet 1 and copy any emails from sheet 2 to column B in sheet1 were there is no email.
  2. If there is already an email in Sheet 1 Column B for THAT URL, then it pastes the new email into column c right row to url.
  3. Any urls on SHEET 2 with or without emails are copied from sheet2 to the last url of Sheet1

:eek:
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
858
Office Version
  1. 2016
Platform
  1. Windows
This is a code that i used in the past to match customer ID and records from one sheet to another. I have made a few changes to it. I can get it to do the following.

1) Match and copy the date from sheet2 to sheet 1

THE PROBLEM

1) The code pastes the data into columns C and D in sheet 1,
2) ANY URLs and EMAIL that are in sheet 2 that DO NOT match sheet 1 are NOT copied FROM sheet2 and pasted under the LAST url in sheet1

Code:
Private Sub CommandButton1_Click()


    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    Dim lr As Long, lr2 As Long, i As Long, j As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = s2.Range("a" & Rows.Count).End(xlUp).Row
    For i = 3 To lr
        For j = 3 To lr2
            If s2.Range("A" & j) = s1.Range("A" & i) Then
                s2.Range("A" & j & ":AB" & j).Copy
                s1.Range("C" & i).PasteSpecial xlPasteValues
            End If
        Next j
    Next i


End Sub

thanks for having a look
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
858
Office Version
  1. 2016
Platform
  1. Windows
Hi

I have noticed another problem with the above code, i have about 12000 URL that it has to check, i works fine up to 2000 urls and then excel stops responding and freezes. is it because it is matching and coping too much data over?
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
858
Office Version
  1. 2016
Platform
  1. Windows
Can anyone help on this please, im really stuck. I haven been searching for the answer on google but can't seem to find the answer.

even the first half of the code would do, I ahve slightly changed my request to make it a bit simpler


  1. MATCH the urls from sheet 2 column A to the urls in sheet 1 column A and then copy those url's and emails from sheet 2 to column C,D in sheet1 in the same row as the matched url.
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
858
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

In my workbook I have two sheets.

In Sheet1 column A I have data, about 12000 records. In Sheet2 I have another large data set.

I need a vba code that will check to see if the records in Sheet 2 also present in Sheet1. If so it will copy those records over to column C IN SHEET1.
When it copies to sheet1 column C FROM SHEET 2 it will copy the data in columns A+B

Sheet 1
A
B
C
D
HAT



CAT



BAT



BALL



HALL



CAR



VAN




<tbody>
</tbody>

Sheet 2
A
B
C
D
VAN
RED


DOG
LARGE


BALL
GREEN


HAT
SMALL


APPLE
RED


TREE
LEMON


BEE
HONEY


BELL
LOUD


BAT
CRICKET



<tbody>
</tbody>

Sheet1 when data has been matched and copied over from sheet 2
A
B
C
D
HAT

HAT
SMALL
CAT



BAT

BAT
CRICKET
BALL

BALL
GREEN
HALL



CAR



VAN

VAN
RED


DOG
LARGE


APPLE
RED


TREE
LEMON


BEE
HONEY


BELL
LOUD





<tbody>
</tbody>
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,010
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Private Sub CommandButton1_Click()
   Dim s1 As Worksheet, s2 As Worksheet
   Dim Cl As Range
   
   Set s1 = Sheets("Sheet1")
   Set s2 = Sheets("Sheet2")
   
   Application.ScreenUpdating = False
   With CreateObject("scripting.dictionary")
      For Each Cl In s2.Range("A6", s2.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Resize(, 27)
      Next Cl
      For Each Cl In s1.Range("A6", s1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 2).Resize(, 27).Value = .Item(Cl.Value)
      Next Cl
   End With
End Sub
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
858
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Fluff

Thank you for this code it is super, could you please slightly tweak this if possible, so any urls that are not matched are copied and pasted in column E sheet1
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,010
Office Version
  1. 365
Platform
  1. Windows
You're code was copying columns A to AB starting at col C, if you then copy data to Col E it will overwrite what has already been copied. :confused:
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
858
Office Version
  1. 2016
Platform
  1. Windows
Thanks Fluff for the code, once again you saved my life.

Also a big thanks to bobsan42, for picking out the mistake. Even with my glasses on I could not see the error, looks like my code was ok all along, the error was mine, . I will stick with Fluffs code as it works better.

I spent days on fixing this. all i need was an eye test, looks like one is due now. lol
 

Watch MrExcel Video

Forum statistics

Threads
1,108,489
Messages
5,523,248
Members
409,506
Latest member
reneekeane

This Week's Hot Topics

Top