Macro Chart Creating

[levanoj]

So I have data that appears as follows:

MODLBUTN(Test2).xlsx
	A	B	C	D
1	LAC	TRID	Group
2	2456	4	Mort
3	2457	4	Mort
4	2458	4	Mort
5	2459	5	Muni
6	2460	5	Muni
7	2461	5	Muni
8	2456	6	EM
9	2457	6	EM
10	2458	6	EM
11	2459	7	Deriv
12	2460	7	Deriv
13	2461	8	Mort
14	2468	8	Mort
15	2469	8	Mort
16	2470	8	Mort
Sheet1

and I'd like a macro to pull the unique "LAC" values (column A) and the unique "TRID" values (Row 1) and convert that data into a chart that appears as follows:

MODLBUTN(Test2).xlsx
	A	B	C	D	E	F
1	TRID	4	5	6	7	8
2	Lac
3	2456	Mort		EM
4	2457	Mort		EM
5	2458	Mort		EM
6	2459		Muni		Deriv
7	2460		Muni		Deriv
8	2461		Muni			Mort
9	2468					Mort
10	2469					Mort
11	2470					Mort
Sheet2

where the corresponding "Group" value in Sheet1 is inserted in the cell where the LAC & TRID intersect.

 

[MickG]

Try this :-
Results sheet(2)

[COLOR=navy]Sub[/COLOR] MG28Jun23
[COLOR=navy]Dim[/COLOR] Rng      [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] Ray1
[COLOR=navy]Dim[/COLOR] Ray2
[COLOR=navy]Dim[/COLOR] Q
[COLOR=navy]Dim[/COLOR] oMax     [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] K
[COLOR=navy]Dim[/COLOR] Rw       [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Lst      [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & rows.count).End(xlUp))
 Ray1 = GetRw(Rng.Offset(, 1))
   ReDim Ray2(1 To Rng.count, 1 To UBound(Ray1))
     [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
            [COLOR=navy]If[/COLOR] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
                n = n + 1
                Ray2(1, 1) = Dn.Offset(, 2)
                Ray2(1, 2) = Dn.Offset(, 1)
                .Add Dn.value, Array(Ray2, 1)
            [COLOR=navy]Else[/COLOR]
                Q = .Item(Dn.value)
                Q(1) = Q(1) + 1
                Q(0)(Q(1), 1) = Dn.Offset(, 2)
                Q(0)(Q(1), 2) = Dn.Offset(, 1)
                .Item(Dn.value) = Q
                oMax = Application.max(Q(1), oMax)
            [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Rw = 2
   Lst = .count
      ReDim nRay(1 To .count + 2, 1 To UBound(Ray1) + 2)
       nRay(1, 1) = "Trid": nRay(2, 1) = "Lac"
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    Rw = Rw + 1
    [COLOR=navy]For[/COLOR] n = 1 To .Item(K)(1)
        nRay(Rw, 1) = K
        nRay(Rw, .Item(K)(0)(n, 2) - 2) = .Item(K)(0)(n, 1)
    [COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("sheet2")
    .Range("A1").Resize(Lst + 2, UBound(Ray1) + 2) = nRay
    .Range("B1").Resize(, UBound(Ray1) + 1) = Ray1
[COLOR=navy]End[/COLOR] With
MsgBox "Run!!"
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Function GetRw(fRng [COLOR=navy]As[/COLOR] Range) [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
    [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] fRng
            .Item(Dn.value) = Dn.value
        [COLOR=navy]Next[/COLOR]
    GetRw = .keys
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] Function

Regards Mick