arrays - Expanding column cells for each column cell -

i have 3 different sets of data (in different columns)

1. animals (5 different kinds) in column
2. fruits (1000 different kinds) in column b
3. countries (10 different kinds) in column c

with these 3 data collections receive 5×1000×10 total of 50k corresponding elements in col. e f g (each animal corresponds each fruit , each country).

it might done manually copying , pasting values, take ages. there way automate vba code or

is there universal formula unlimited data sets 1 presented above? please let me know if not clear.

here smaller example of data , how results should turn out:

        

my first approach problem similar 1 posted @jeeped:

1. load input columns array , count rows in each column
2. fill array combinations
3. assign array output range

using microtimer have calculated average times taken each part of above algorithm. part 3. took 90%-93% of total execution time bigger input data.

below attempt improve speed of writing data worksheet. have defined constant iminrsize=17. once possible fill more iminrsize consecutive rows same value, code stops filiing array , writes directly worksheet range.

sub crossjoin(rsrc range, rtrg range)    dim vsrc() variant, vtrgpart() variant   dim ilengths() long   dim iccnt integer, irtrgcnt long, irsrccnt long   dim integer, j long, k long, l long   dim istep long    const iminrsize long = 17   dim iarrlastc integer    on error goto cleanup   application.screenupdating = false   application.enableevents = false    vsrc = rsrc.value2   iccnt = ubound(vsrc, 2)   irsrccnt = ubound(vsrc, 1)   irtrgcnt = 1   iarrlastc = 1   redim ilengths(1 iccnt)   = 1 iccnt     j = irsrccnt     while (j > 0) , isempty(vsrc(j, i))       j = j - 1     wend     ilengths(i) = j     irtrgcnt = irtrgcnt * ilengths(i)     if (irtrgcnt < iminrsize) , (iarrlastc < iccnt) iarrlastc = iarrlastc + 1   next    if (irtrgcnt > 0) , (rtrg.row + irtrgcnt - 1 <= rtrg.parent.rows.count)     redim vtrgpart(1 irtrgcnt, 1 iarrlastc)      istep = 1     = 1 iarrlastc       k = 0       j = 1 irtrgcnt step istep         k = k + 1         if k > ilengths(i) k = 1         l = j j + istep - 1           vtrgpart(l, i) = vsrc(k, i)         next l       next j       istep = istep * ilengths(i)     next      rtrg.resize(irtrgcnt, iarrlastc) = vtrgpart      = iarrlastc + 1 iccnt       k = 0       j = 1 irtrgcnt step istep         k = k + 1         if k > ilengths(i) k = 1         rtrg.resize(istep).offset(j - 1, - 1).value2 = vsrc(k, i)       next j       istep = istep * ilengths(i)     next   end if  cleanup:   application.screenupdating = true   application.enableevents = false end sub  sub test()   crossjoin range("a2:f10"), range("k2") end sub 

if set iminrsize rows.count, data written array. below sample test results:

the code works best if input columns highest number of rows come first, wouldn't big problem modify code rank columns , process in right order.