VBA to copy values based on identical text strings in cells and remove duplicates

smide

smide

Board Regular
Joined
Dec 20, 2015
Messages
164
Office Version
  1. 2016
Platform
  1. Windows
In Sheet1 (starting from row3, A-X columns) I have a data summary (product's mark and product's prices) and Sheet2 is only for the raw data.

Product's mark is characteristic which contains one to six letters (always to the left of price).

I need a Macro to copy/append data from Sheet2 to Sheet1 in an appropriate column (based on identical products columns). // something like hlookup function in macro
Also, I need to remove (if there are) duplicates based on mark columns (cells which already contains the same marks as marks in Sheet1).

Example.

Sheet1 (before update)

[TABLE="class: grid, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Product1[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Product5[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Product4
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]a[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]b[/TD]
[TD="align: center"]21[/TD]
[TD="align: center"]s[/TD]
[TD="align: center"]11[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]b[/TD]
[TD="align: center"]8[/TD]
[TD="align: center"]f[/TD]
[TD="align: center"]16[/TD]
[TD="align: center"]pq[/TD]
[TD="align: center"]31[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]c[/TD]
[TD="align: center"]12[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]rd[/TD]
[TD="align: center"]11[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]w[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]

Sheet2 (obtained new "raw" data)

[TABLE="class: grid, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Product4[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Product1[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Product5
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]w[/TD]
[TD="align: center"]12[/TD]
[TD="align: center"]b[/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]f[/TD]
[TD="align: center"]18[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]d
[/TD]
[TD="align: center"]34[/TD]
[TD="align: center"]c[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]g
[/TD]
[TD="align: center"]31
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]e
[/TD]
[TD="align: center"]28
[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: center"][/TD]
[TD="align: center"]....[/TD]
[TD="align: center"][/TD]
[TD="align: center"]....[/TD]
[TD="align: center"][/TD]
[TD="align: center"]....[/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]

Sheet1 (after update/append from Sheet2, with removed duplicates/same dates)
[TABLE="class: grid, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]Product1
[/TD]
[TD][/TD]
[TD]Product5[/TD]
[TD][/TD]
[TD]Product4[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]a[/TD]
[TD="align: center"] 13[/TD]
[TD]b[/TD]
[TD="align: center"]21[/TD]
[TD="align: center"]s[/TD]
[TD="align: center"]11[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]b[/TD]
[TD="align: center"]8[/TD]
[TD]f[/TD]
[TD="align: center"]16[/TD]
[TD="align: center"]pq[/TD]
[TD="align: center"]31[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]c[/TD]
[TD="align: center"]12[/TD]
[TD]g
[/TD]
[TD="align: center"]31
[/TD]
[TD="align: center"]rd[/TD]
[TD="align: center"]11[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]e
[/TD]
[TD="align: center"]28
[/TD]
[TD][/TD]
[TD="align: center"][/TD]
[TD="align: center"]w[/TD]
[TD="align: center"]9[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD][/TD]
[TD="align: center"]....[/TD]
[TD="align: center"][/TD]
[TD="align: center"].....[/TD]
[TD="align: center"]d
[/TD]
[TD="align: center"]34
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"]....[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
Try this For Update of sheet1 from sheet2.
NB:- Run code from sheet1
Code: 
[COLOR="Navy"]Sub[/COLOR] MG20Aug39
[COLOR="Navy"]Dim[/COLOR] cRng [COLOR="Navy"]As[/COLOR] Range, cDn [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Rng [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] cRng2 [COLOR="Navy"]As[/COLOR] Range, cDn2 [COLOR="Navy"]As[/COLOR] Range, Dn2 [COLOR="Navy"]As[/COLOR] Range, Rng2 [COLOR="Navy"]As[/COLOR] Range, temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] cRng = Range(Range("A3"), Cells(3, Columns.Count).End(xlToLeft))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] cDn [COLOR="Navy"]In[/COLOR] cRng
    c = 0
    [COLOR="Navy"]Dim[/COLOR] ray()
     [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    [COLOR="Navy"]If[/COLOR] Len(cDn.Value) [COLOR="Navy"]Then[/COLOR]
        temp = cDn.Value
         [COLOR="Navy"]Set[/COLOR] Rng = Range(Cells(4, cDn.Column - 1), Cells(Rows.Count, cDn.Column - 1).End(xlUp))
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                    c = c + 1
                    ReDim Preserve ray(1 To 2, 1 To c)
                    ray(1, c) = Dn.Value: ray(2, c) = Dn.Offset(, 1)
                    Dic.Add (Dn.Value), Nothing
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]End[/COLOR] If

[COLOR="Navy"]If[/COLOR] Dic.Count <> 0 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
[COLOR="Navy"]Set[/COLOR] cRng2 = .Range(.Range("A3"), .Cells(3, .Columns.Count).End(xlToLeft))

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] cDn2 [COLOR="Navy"]In[/COLOR] cRng2
    [COLOR="Navy"]If[/COLOR] Len(cDn2.Value) And cDn2.Value = temp [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Rng2 = .Range(.Cells(4, cDn2.Column - 1), .Cells(Rows.Count, cDn2.Column - 1).End(xlUp))
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn2 [COLOR="Navy"]In[/COLOR] Rng2
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn2.Value) [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            ReDim Preserve ray(1 To 2, 1 To c)
            ray(1, c) = Dn2.Value: ray(2, c) = Dn2.Offset(, 1)
            Dic.Add (Dn2.Value), Nothing
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Dn2
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] cDn2
[COLOR="Navy"]With[/COLOR] Cells(4, cDn.Column - 1).Resize(c, 2)
    .Value = Application.Transpose(ray)
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] cDn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
remove duplicate with exceptional
Replies
7
Views
233
kelvin_9
K
S
  • Solved
Pairwise Comparison Table
Replies
4
Views
361
Samgraphics
S
C
  • Solved
VBA Check for duplicate value and change if duplicate.
Replies
7
Views
479
Alex Blakenburg
A
D
  • Question Question
Assign dates as late as possible without duplicates
Replies
1
Views
145
AlphaFrog
AlphaFrog
O
  • Question Question
VBA batch print to PDF
Replies
2
Views
474
okvals48
O

Forum statistics

Threads
1,223,719
Messages
6,174,089
Members
452,542
Latest member
Bricklin

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