Transfer data from sheet 1 to sheet 2 using partial data match

[Lefty099]

Hi all, thank you in advance for your assistance.

I am preparing a product performance tracker for the business but I am having a lot of trouble with one little piece.

On Sheet 1 Column E I have a list of all the products. Sheet 1 Column I contains the Product Category. The category has 3 numbers then a series of letters. eg 057DINDINTRE. or 058LOULOUITY

On Sheet 2 Column b is the values I want to look up. eg 057, or 058, or 056 etc

What I need to happen is search Sheet1 Column I for a partial match of all the Sheet2 Column B and return the value from Sheet1 Column E to sheet 3 Column A. If Sheet1 Column I does not contain the 056,057 etc I need it excluded from the transfer to sheet 3.

The sheet 1 report changes every day as stock level increase and decreases, so I need sheet 3 to reflect these changes as well.

EG
Sheet 1 - Main report - Shows product and category, first three digits the key factor.

	A	B	C	D	E	F	G	H	I
1	Drill	056HAMHGY
2	Hammer	057DREKIL
3	Drill	025HYGTED
4	Cage	057GDEOIH
5	Nails	060GTHKHF
6	Bolts	090BOLYHG
7	Nuts	090NUTGGG
8	Claw Hammer	057DREKIL
9

<tbody>
</tbody>

Sheet 2 - Reference list for above sheet to lookup

	A	B
1	040
2	042
3	050
4	056
5	057
6	060
7

<tbody>
</tbody>

Sheet 3 - End result, all products from first list containing the first 3 digits listed in sheet 2 transferred to next page. The 025, and 090 products are excluded along with any other rows not listed in sheet 2, A1:A6. Notice that A1 and A5 below have the same group (057DREKIL), I need every record transferred providing the 057, 060 etc is met.

	A	B	C	D	E	F	G	H	I
1	056HAMHGY	DRILL
2	057DREKIL	Hammer
3	057GDEOIH	Cage
4	060GTHKHF	Nails
5	057DREKIL	Claw Hammer
6
7
8
9

<tbody>
</tbody>

I sincerely hope this all makes sense. Thanks you one again.

 

[MickG]

Try this for Results on sheet 3.

[COLOR="Navy"]Sub[/COLOR] MG04Jun12
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    .Item(Dn.Value) = Empty
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 2)
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] .exists(Left(Dn.Offset(, 1).Value, 3)) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
       ray(c, 2) = Dn.Value: ray(c, 1) = Dn.Offset(, 1).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3").Range("A1").Resize(c, 2)
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Aladin Akyurek]

Given the data of Sheet1 and Sheet2:

Sheet3...

Row\Col	A​	B​	C​
1​	5​
2​	056HAMHGY	Drill	1
3​	057DREKIL	Hammer	2
4​	057GDEOIH	Cage	4
5​	060GTHKHF	Nails	5
6​	057DREKIL	Claw Hammer	8
7​

<strike></strike>
In A1 control+shift+enter, not just enter:

=SUM(IF(ISNUMBER(MATCH(LEFT(Sheet1!$B$1:$B$8,3),Sheet2!$A$1:$A$6,0)),1))

In A2 just enter and copy down:

<strike></strike>=IF($C2="","",INDEX(Sheet1!$B$1:$B$8,$C2))<strike></strike>

In B2 just enter and copy down:

=IF($C2="","",INDEX(Sheet1!$A$1:$A$8,$C2))

In C2 control+shift+enter, not just enter, and copy down:

<strike></strike>=IF(ROWS($A$2:A2)<=$A$1,SMALL(IF(ISNUMBER(MATCH(LEFT(Sheet1!$B$1:$B$8,3),
    Sheet2!$A$1:$A$6,0)),ROW(Sheet1!$B$1:$B$8)-ROW(Sheet1!$B$1)+1),ROWS($A$2:A2)),"")<strike></strike>

 

[Lefty099]

Thanks Mick, this is transferring everything across very nice and quick. Just one more little thing, is there a way I can now remove duplicate from sheet 3 column B??

Thanks

 

[Lefty099]

Also, If I also wanted to copy data from Sheet 1 columns, C,D,E,F and G. How would I code that. I do apologise for this, VBA is very very new to me.

Thanks heaps

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG05Jun39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRay [COLOR="Navy"]As[/COLOR] Variant, Dic [COLOR="Navy"]As[/COLOR] Object, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    .Item(Dn.Value) = Empty
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
   nRay = .Range("A2").CurrentRegion
   ReDim ray(1 To UBound(nRay, 1), 1 To UBound(nRay, 2))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(nRay, 1)
    [COLOR="Navy"]If[/COLOR] .Exists(Left(nRay(n, 2), 3)) [COLOR="Navy"]Then[/COLOR]
       [COLOR="Navy"]If[/COLOR] Not Dic.Exists(nRay(n, 1)) [COLOR="Navy"]Then[/COLOR]
            Dic(nRay(n, 1)) = Empty
            c = c + 1
            [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(nRay, 2)
                ray(c, Ac) = nRay(n, Ac)
                ray(c, 2) = nRay(n, 1): ray(c, 1) = nRay(n, 2)
            [COLOR="Navy"]Next[/COLOR] Ac
       [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3").Range("A1").Resize(c, UBound(nRay, 2))
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick