Merging spreadsheets

[brickleul]

Hi,

I'm looking to merge two sheets , a data consolidation. I have the following structure

Sheet1

A	B
discuss with client	EA-11-99379
request documents	FA-12-11458
rescheduled	GC-12-87663
request ASPC	DL-11-110677

<tbody>
</tbody>

Sheet2

A	B	C	D
EA-11-99379	CAR	BMW	John
EA-11-99379	RAR	BMW	John
FA-12-11458	CAR	OPEL	Emily
GC-12-87663	RATT	FORD
FA-12-11458	RAR	OPEL	John
EA-11-99379	RATT	BMW	Denis

<tbody>
</tbody>

What I'm looking for is the following result or something similar:

discuss with client	EA-11-99379	CAR	BMW	John
		RAR	BMW	John
		RATT	BMW	Denis
request documents	FA-12-11458	CAR	OPEL	Emily
		RAR	OPEL	John
rescheduled	GC-12-87663

<tbody>
</tbody>

A short legend Sheet 1 : Col. A is the task ,Col B is the file no.
Sheet2: A-file no. , B-file type , C- client ; D- assigned person ( can be blank)


Can anyone help me with an idea? For now we designed one person to check task by task and send to appropriate person but we have hundreds of task so any help is very welcome. Thanks

 

[MickG]

Try this:-
Your Data on sheet 1 and sheets2 as per thread
Data in both sheets starts row2.
Results start sheet3, row 2.

[COLOR="Navy"]Sub[/COLOR] MG28Aug52
[COLOR="Navy"]Dim[/COLOR] Rng1            [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn              [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n               [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng2            [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic             [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Q               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ray             [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] k               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] G               [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c               [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]


[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With


ReDim nray(1 To Rng2.Count * 2, 1 To 5)
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
            Ray = Array(Rng1, Rng2)
[COLOR="Navy"]For[/COLOR] n = 0 To 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Ray(n)
        [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            Dic.Add Dn.Value, Array(Dn, Nothing)
        [COLOR="Navy"]Else[/COLOR]
            Q = Dic.Item(Dn.Value)
                [COLOR="Navy"]If[/COLOR] Q(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
                [COLOR="Navy"]Else[/COLOR]
                    [COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn)
                [COLOR="Navy"]End[/COLOR] If
            Dic.Item(Dn.Value) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] n


 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
    c = c + 1
    nray(c, 1) = Dic.Item(k)(0).Offset(, -1).Value
    nray(c, 2) = Dic.Item(k)(0).Value
    [COLOR="Navy"]If[/COLOR] Not Dic.Item(k)(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] G [COLOR="Navy"]In[/COLOR] Dic.Item(k)(1)
            nray(c, 3) = G.Offset(, 1).Value
            nray(c, 4) = G.Offset(, 2).Value
            nray(c, 5) = G.Offset(, 3).Value
            c = c + 1
        [COLOR="Navy"]Next[/COLOR] G
            c = c - 1
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] k
 Sheets("Sheet3").Range("A2").Resize(c, 5) = nray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[brickleul]

Thank you very much , I had to do some tweaks but works perfect . I really appreciate your help

 

[MickG]

You're welcome