How to convert flatten table to 2D Excel table

[martinkabe]

Hi experts, I have a "flatten" table with countries and years in Excel. eg.

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;"> Country Year Value
USA 1961 a
USA 1962 x
USA 1963 g
USA 1964 y
France 1961 u

...

</code>And I'd like to have a two dimensional table as following:

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;"> 1961 1962 1963 1964
USA a x g y
France u e h a
Germany o x n p

</code>Do you happen to know, how to do that programmatically in Excel using VBA. Many thanks in forward for any hint or advice.<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">
</code>

 

[Kyle123]

A Pivot table'll work depending on the actual contents of the value field

 

[martinkabe]

A Pivot table'll work depending on the actual contents of the value field

Pivot table won't be good solution for that...

 

[Kyle123]

Why?

 

[MickG]

Try this:-
Results start "D1"

[COLOR=Navy]Sub[/COLOR] MG14Oct14
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, Ray(), c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object, Dic1 [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
 ReDim Ray(1 To Rng.Count, 1 To 1)
 c = 1
 [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
 Dic.CompareMode = vbTextCompare
 [COLOR=Navy]With[/COLOR] CreateObject("System.Collections.ArrayList")
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
                [COLOR=Navy]If[/COLOR] Not .Contains(Dn.Value) [COLOR=Navy]Then[/COLOR]
                    c = c + 1
                    ReDim Preserve Ray(1 To Rng.Count, 1 To c)
                    Ray(1, c) = Dn.Value
                    .Add Dn.Value
                    Dic.Add Dn.Value, c
                [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]Next[/COLOR] Dn
            .Sort
 [COLOR=Navy]End[/COLOR] With
c = 1: Ray(1, 1) = "Country"
[COLOR=Navy]Set[/COLOR] Dic1 = CreateObject("scripting.dictionary")
 Dic1.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Offset(, -1)
   [COLOR=Navy]If[/COLOR] Not Dic1.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        c = c + 1
        Ray(c, 1) = Dn.Value
        Ray(c, Dic(Dn.Offset(, 1).Value)) = Dn.Offset(, 2)
        Dic1.Add Dn.Value, c
   [COLOR=Navy]Else[/COLOR]
      Ray(Dic1(Dn.Value), Dic(Dn.Offset(, 1).Value)) = Dn.Offset(, 2)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
 Range("D1").Resize(c, UBound(Ray, 2)) = Ray
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick