Copy paste multiple columns based on the account name

R

raviansal

New Member
Joined
Mar 6, 2022
Messages
5
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
Platform
  1. Windows
Hi team,

Can you please help me find a solution to the below issue? I tried Vlookup, but it is really time-consuming.

I have two sheets. One with the contact details and one with the product details. I want them to map it based on the account data.
Sheet 1:
1649344037775.png


Sheet 2
1649344123886.png


Result required :
1649344334612.png


There 3500 contacts and every time i try look up it doesnot lock on the lock up fields.
I will add a sample data below :

First sheet:
FirstLastEmailAccount Name
VipwhqwlqwuuolognnoVipwhqwlqw.uuolognno@oVtqwpwh-gVuuh.xqwogoplqwsionn ollg. QronnQqwnnhous
onnnnqwttnqwigqworthopoqwxiqw@oQh-hogqwnn.xqwogoplqwsionn ollg. QronnQqwnnhous
HqwiQqwTrqwipwhqwlorthopoqwxiqw@oQh-hogqwnn.xqwogoplqwsionn ollg. QronnQqwnnhous
StqwnonnHoopshoops@xioQo-onnlinnqw.xqwogoplqwsionn xioQonniqwQlinniQuV
QorstqwnnTiVVQ.tiVV@xioQo-onnlinnqw.xqwogoplqwsionn xioQonniqwQlinniQuV
ouurohoVVqwozoouurohoV.Vqwozo@x-Q-h.xqwogoplqwsionn xioQonniqwQlinniQuV
nrqwxqwriQPolqwtznrqwxqwriQ.polqwtz@oVtqwpwh-gVuuh.xqwogoplqwsionn xioQonniqwQlinniQuV
qwpwQorxViqwlQqwViqwlQqw@xioQo-onnlinnqw.xqwogoplqwsionn xioQonniqwQlinniQuV
UlripwhLohnqwlxulripwh.lohnqwlx@oVtqwpwh-gVuuh.xqwogoplqwsionn xioQonniqwQlinniQuV
VonnnrqwxSiluuqwrstqwinnsiluuqwrstqwinn@onnlinnqw.xqwogoplqwsionn xioQonniqwQlinniQuV
GqwsoxiqwrpwQsqwnngqwso.xiqwrpwQsqwnn@x-Q-h.xqwogoplqwsionn xioQonniqwQlinniQuV HoVuuurg
Tilqwnniusjqwnns.uuipwQqwrt@uuothilxis.xqwoGoPLqwSIOnn qwv. uuothilxisQronnQqwnn-
VortinnVitzithuVVortinn.vitzithuV@uuothilxis.xqwoGoPLqwSIOnn qwv. uuothilxisQronnQqwnn-
SusonnnnqwRuVuuqwrgqwrsusonnnnqw.ruVuuqwrgqwr@uuothilxis.xqwoGoPLqwSIOnn qwv. uuothilxisQronnQqwnn-
VortinnoSpwhoQqwVortinno.spwhoQqw@uuothilxis.xqwoGoPLqwSIOnn qwv. uuothilxisQronnQqwnn-
QqwvinnRqwusQqwvinn.rqwus@oVtqwpwh-gVuuh.xqwoGoPLqwSIOnn qwv. uuothilxisQronnQqwnn-
Voxqwlqwinnqwvonn uuqwhrqwnnhygiqwnnqw-nxQ@nxQ.innnoogoplqwsionn QronnQqwnnhous uuqwthonniqwnn
qwlQqwpwonnroxpwonnrox_qw@Qlinn-rt.xqwoluuQlinniQ Vünnsinngqwnn
StqwphonnSpwhoon-qwnngqwlsstqwphonn.spwhoon-qwnngqwls@olqwxionnqwr.xqwolqwxionnqwr Qrqwnqwlx GVuuH
pwhristionnuuuspwhpwhristionn.uuuspwh@olqwxionnqwr-Qrqwnqwlx.xqwolqwxionnqwr Qrqwnqwlx GVuuH
xonniqwlnnqwusqwrx.nnqwusqwr@olqwxionnqwr.xqwolqwxionnqwr Qrqwnqwlx GVuuH
LinnxoQuoyl.quoy@olqwxionnqwr.xqwolqwxionnqwr Qrqwnqwlx GVuuH
VonnjoHirVqwrVonnjo.hirVqwr@Qrupp-QronnQqwnnhous.xqwolnriqwx Qrupp QronnQqwnnhous
PqwtroJopppqwtro.jopp@Qrupp-QronnQqwnnhous.xqwolnriqwx Qrupp QronnQqwnnhous
JürgqwnnLilljuqwrgqwnn.lill@Qrupp-QronnQqwnnhous.xqwolnriqwx Qrupp QronnQqwnnhous
Woln-RüxigqwrHqwnnnnqwpwQwoln-ruqwxigqwr.hqwnnnnqwpwQ@Qrupp-QronnQqwnnhous.xqwolnriqwx Qrupp QronnQqwnnhous
Wiqwnnonnxshnno@Qrupp-QronnQqwnnhous.xqwolnriqwx Qrupp QronnQqwnnhous
VipwhoqwlGonntqwrVqwxizinntqwpwhnniQ@Qrupp-QronnQqwnnhous.xqwolnriqwx Qrupp QronnQqwnnhous

Sheet 2:
Customer NameCFN 1CFN Description 1Serial number 1CFN 2CFN Description 2Serial number 2CFN 3CFN Description 3Serial number 3CFN 4CFN Description 4Serial number 4CFN 5CFN Description 5Serial number 5CFN 6CFN Description 6Serial number 6CFN 7CFN Description 7Serial number 7CFN 8CFN Description 8Serial number 8CFN 9CFN Description 9Serial number 9
ogoplqwsionn ollg. QronnQqwnnhous8253200Oranges INTERFACE 82X017058348253002Apples8253002 NI2NR3-12908253010MINI SCREEN 8253010MS-0480
ogoplqwsionn xioQonniqwQlinniQuV8253200Oranges INTERFACE 82X063236931898001Yellow 1898001 CloudENTC818941898430Spider SWITCH 1898430FS-104921899200RatsRIDER 189920M5-68258253002Apples8253002 NI2NR3-25088253200Oranges INTERFACE 82X30422878
ogoplqwsionn xioQonniqwQlinniQuV HoVuuurg8253002Apples8253002 NI2NR3-15118253200Oranges INTERFACE 82X04094495
oGoPLqwSIOnn qwv. uuothilxisQronnQqwnn-8253200Oranges INTERFACE 82X040877648253002Apples8253002 NI2NR3-1746
ogoplqwsionn QronnQqwnnhous uuqwthonniqwnn3327750HANDPIECE 3327750 POA127558253002Apples8253002 NI2NR3-05171898001Yellow 1898001 CloudENTC840351899200RatsRIDER 189920M5-133941898430Spider SWITCH 1898430FS-U14317
oluuQlinniQ Vünnsinngqwnn8253200Oranges INTERFACE 82X046671848253002Apples8253002 NI2NR3-2021
olqwxionnqwr Qrqwnqwlx GVuuH1895400Cats 1895400 X102051898200TRatsRIDER 18982025891898200TRatsRIDER 18982026401898200TRatsRIDER 18982026411899200RatsRIDER 189920M5-58481898001Yellow 1898001 CloudENTC818281898430Spider SWITCH 1898430FS-110331899200RatsRIDER 189920M5-081461899200RatsRIDER 189920M5-08179
olnriqwx Qrupp QronnQqwnnhous1895400Cats 1895400 X116151898200TRatsRIDER 18982051061897200HANDPIECE 1897200 MA2451895400Cats 1895400 X126111898200TRatsRIDER 189820HP-216371898200TRatsRIDER 189820HP-216528253200Oranges INTERFACE 82X075659038253002Apples8253002 NI2NR3-38661899200RatsRIDER 189920M5-13488

Please help me with the solution.

Best regards,
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
Try this. Results on Sheet3

VBA Code: 
Sub CombineMultipleColumns()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, n As Long
  Dim dic As Object
  
  a = Sheets("Sheet1").Range("A1").CurrentRegion.Value
  b = Sheets("Sheet2").Range("A1").CurrentRegion.Value
  ReDim c(1 To UBound(a, 1), 1 To UBound(b, 2) + 3)
  
  Set dic = CreateObject("Scripting.Dictionary")
  dic.CompareMode = vbTextCompare
  
  b(1, 1) = a(1, 4)
  For i = 1 To UBound(b, 1)
    dic(b(i, 1)) = i
  Next
  For i = 1 To UBound(a, 1)
    If dic.Exists(a(i, 4)) Then
      n = dic(a(i, 4))
      For j = 1 To UBound(a, 2)
        c(i, j) = a(i, j)
      Next
      For j = 2 To UBound(b, 2)
        c(i, j + 3) = b(n, j)
      Next
    End If
  Next
  Sheets("Sheet3").Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
 
Upvote 0
Hi Dante,

Thank you for the help. I tried to do it but was unsuccessful. This is the first time I'm using a VBA script.
Can you please help me with the below error?
1649608491315.png
1649608535210.png


Please let me know if more information is required.

Best regards,
Ravi Ansal
 
Upvote 0
Are you testing with the data you put in your initial post?
Do you have empty rows or columns in your data and then your data continues?

Try this:

VBA Code: 
Sub CombineMultipleColumns()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, n As Long, lr1 As Long, lc1 As Long, lr2 As Long, lc2 As Long
  Dim dic As Object
  
  lr1 = Sheets("Sheet1").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
  lr2 = Sheets("Sheet1").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
  lc1 = Sheets("Sheet1").Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  lc2 = Sheets("Sheet2").Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  a = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(lr1, lc1)).Value
  b = Sheets("Sheet2").Range("A1", Sheets("Sheet2").Cells(lr2, lc2)).Value
  ReDim c(1 To UBound(a, 1), 1 To UBound(b, 2) + 3)
  
  Set dic = CreateObject("Scripting.Dictionary")
  dic.CompareMode = vbTextCompare
  
  b(1, 1) = a(1, 4)
  For i = 1 To UBound(b, 1)
    dic(b(i, 1)) = i
  Next
  For i = 1 To UBound(a, 1)
    If dic.Exists(a(i, 4)) Then
      n = dic(a(i, 4))
      For j = 1 To UBound(a, 2)
        c(i, j) = a(i, j)
      Next
      For j = 2 To UBound(b, 2)
        c(i, j + 3) = b(n, j)
      Next
    End If
  Next
  Sheets("Sheet3").Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,813
Messages
6,181,107
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top