My first approach to this problem was similar to the one posted by @Jeeped:

1. load input columns to array and count rows in each column
2. fill array with all combinations
3. assign array to output range

Using MicroTimer I have calculated average times taken by each part of the above algorithm. Part 3. took 90%-93% of total execution time for bigger input data.

Below is my attempt to improve the speed of writing data to worksheet. I have defined a constant iMinRSize=17. Once it is possible to fill more than iMinRSize consecutive rows with the same value, the code stops filiing array and writes directly to worksheet range.

Sub CrossJoin(rSrc As Range, rTrg As Range)

  Dim vSrc() As Variant, vTrgPart() As Variant
  Dim iLengths() As Long
  Dim iCCnt As Integer, iRTrgCnt As Long, iRSrcCnt As Long
  Dim i As Integer, j As Long, k As Long, l As Long
  Dim iStep As Long

  Const iMinRSize As Long = 17
  Dim iArrLastC As 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 To iCCnt)
  For i = 1 To iCCnt
    j = iRSrcCnt
    While (j > 0) And IsEmpty(vSrc(j, i))
      j = j - 1
    Wend
    iLengths(i) = j
    iRTrgCnt = iRTrgCnt * iLengths(i)
    If (iRTrgCnt < iMinRSize) And (iArrLastC < iCCnt) Then iArrLastC = iArrLastC + 1
  Next i

  If (iRTrgCnt > 0) And (rTrg.row + iRTrgCnt - 1 <= rTrg.Parent.Rows.Count) Then
    ReDim vTrgPart(1 To iRTrgCnt, 1 To iArrLastC)

    iStep = 1
    For i = 1 To iArrLastC
      k = 0
      For j = 1 To iRTrgCnt Step iStep
        k = k + 1
        If k > iLengths(i) Then k = 1
        For l = j To j + iStep - 1
          vTrgPart(l, i) = vSrc(k, i)
        Next l
      Next j
      iStep = iStep * iLengths(i)
    Next i

    rTrg.Resize(iRTrgCnt, iArrLastC) = vTrgPart

    For i = iArrLastC + 1 To iCCnt
      k = 0
      For j = 1 To iRTrgCnt Step iStep
        k = k + 1
        If k > iLengths(i) Then k = 1
        rTrg.Resize(iStep).Offset(j - 1, i - 1).Value2 = vSrc(k, i)
      Next j
      iStep = iStep * iLengths(i)
    Next i
  End If

CleanUp:
  Application.ScreenUpdating = True
  Application.EnableEvents = False
End Sub

Sub test()
  CrossJoin Range("a2:f10"), Range("k2")
End Sub

If we set iMinRSize to Rows.Count, all data is written to array. Below are my sample test results:

The code works best if input columns with highest number of rows come first, but it wouldn't be a big problem to modify code to rank columns and process in right order.

Change the column width and row height - Excel, Learn how to resize your Excel worksheet rows or columns manually using your If you find yourself needing to expand or reduce Excel's row widths and column heights, there are several ways to adjust them. The table below shows the minimum, maximum and default sizes for each Under Cell Size, click Column Width. Expanding column cells for each column cell. With these 3 data collections I would like to receive 5×1000×10 for a total of 50k corresponding elements in col. E F G (each animal who corresponds with each fruit and each country). It might be done by manually copying and pasting values, but it will take ages.

I gather by universal, you want this to accommodate any number of columns and any number of entries in each. A few variant arrays should provide the dimensions necessary to calculate the cycles of repetition for each value.

Option Explicit

Sub main()
    Call for_each_in_others(rDATA:=Worksheets("Sheet3").Range("A3"), bHDR:=True)
End Sub

Sub for_each_in_others(rDATA As Range, Optional bHDR As Boolean = False)
    Dim v As Long, w As Long
    Dim iINCROWS As Long, iMAXROWS As Long, sErrorRng As String
    Dim vVALs As Variant, vTMPs As Variant, vCOLs As Variant

    On Error GoTo bm_Safe_Exit
    appTGGL bTGGL:=False

    With rDATA.Parent
        With rDATA(1).CurrentRegion
            'Debug.Print rDATA(1).Row - .Cells(1).Row
            With .Resize(.Rows.Count - (rDATA(1).Row - .Cells(1).Row), .Columns.Count).Offset(2, 0)
                sErrorRng = .Address(0, 0)
                vTMPs = .Value2
                ReDim vCOLs(LBound(vTMPs, 2) To UBound(vTMPs, 2))
                iMAXROWS = 1
                'On Error GoTo bm_Output_Exceeded
                For w = LBound(vTMPs, 2) To UBound(vTMPs, 2)
                    vCOLs(w) = Application.CountA(.Columns(w))
                    iMAXROWS = iMAXROWS * vCOLs(w)
                Next w

                'control excessive or no rows of output
                If iMAXROWS > Rows.Count Then
                    GoTo bm_Output_Exceeded
                ElseIf .Columns.Count = 1 Or iMAXROWS = 0 Then
                    GoTo bm_Nothing_To_Do
                End If

                On Error GoTo bm_Safe_Exit
                ReDim vVALs(LBound(vTMPs, 1) To iMAXROWS, LBound(vTMPs, 2) To UBound(vTMPs, 2))
                iINCROWS = 1
                For w = LBound(vVALs, 2) To UBound(vVALs, 2)
                    iINCROWS = iINCROWS * vCOLs(w)
                    For v = LBound(vVALs, 1) To UBound(vVALs, 1)
                        vVALs(v, w) = vTMPs((Int(iINCROWS * ((v - 1) / UBound(vVALs, 1))) Mod vCOLs(w)) + 1, w)
                    Next v
                Next w
            End With
        End With
        .Cells(2, UBound(vVALs, 2) + 2).Resize(1, UBound(vVALs, 2) + 2).EntireColumn.Delete
        If bHDR Then
            rDATA.Cells(1, 1).Offset(-1, 0).Resize(1, UBound(vVALs, 2)).Copy _
                Destination:=rDATA.Cells(1, UBound(vVALs, 2) + 2).Offset(-1, 0)
        End If
        rDATA.Cells(1, UBound(vVALs, 2) + 2).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
    End With

    GoTo bm_Safe_Exit
bm_Nothing_To_Do:
    MsgBox "There is not enough data in  " & sErrorRng & " to perform expansion." & Chr(10) & _
           "This could be due to a single column of values or one or more blank column(s) of values." & _
            Chr(10) & Chr(10) & "There is nothing to expand.", vbInformation, _
           "Single or No Column of Raw Data"
    GoTo bm_Safe_Exit
bm_Output_Exceeded:
    MsgBox "The number of expanded values created from " & sErrorRng & _
           " (" & Format(iMAXROWS, "\> #, ##0") & " rows × " & UBound(vTMPs, 2) & _
           " columns) exceeds the rows available (" & Format(Rows.Count, "#, ##0") & ") on this worksheet.", vbCritical, _
           "Too Many Entries"
bm_Safe_Exit:
    appTGGL
End Sub

Sub appTGGL(Optional bTGGL As Boolean = True)
    Application.EnableEvents = bTGGL
    Application.ScreenUpdating = bTGGL
End Sub

Put the column header labels in row 2 starting in column A and the data directly below that.

I have added some error control to warn of exceeding the number of rows on a worksheet. This is not normally something that is likely to be a consideration but multiplying the number of values in an undetermined number of columns against each other can quickly produce a large number of results. It is not unforeseeable that you would exceed 1,048,576 rows.

Can I Resize a Single Cell in a Column or a Row in Microsoft Excel , Under "Cells," click "Format" and click "Column Width" under "Cell Size. feature to automatically contract or expand cells in Excel to fit their contents. If you want to apply AutoFit to an entire spreadsheet, click "Select All" in the "Edit" menu. For Each cell In Range("B2:B" & LastRow) As an observation the code is a bit lacking inconsistency. the coder uses With Worksheets(sSheetName) but then defines sheetname as the active sheet so the WITH statement isn't necessary as it would work on the active sheet without that.

Classic example of a non-join select SQL statement which returns the Cartesian Product of all combination outcomes of listed tables.

SQL Database Solution

Simply import Animals, Fruit, Country as separate tables into any SQL database like MS Access, SQLite, MySQL, etc. and list tables without joins including implicit (WHERE) and explicit (JOIN) joins:

SELECT Animals.Animal, Fruits.Fruit, Countries.Country
FROM Animals, Countries, Fruits;

Excel Solution

Same concept with running the non-join SQL statement in VBA using an ODBC connection to workbook containing ranges of Animals, Countries, and Fruits. In example, each data grouping is in its own worksheet of same name.

Sub CrossJoinQuery()

    Dim conn As Object
    Dim rst As Object
    Dim sConn As String, strSQL As String

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    sConn = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
               & "DBQ=C:\Path To\Excel\Workbook.xlsx;"
    conn.Open sConn

    strSQL = "SELECT * FROM [Animals$A1:A3], [Fruits$A1:A3], [Countries$A1:A3] "
    rst.Open strSQL, conn

    Range("A1").CopyFromRecordset rst

    rst.Close
    conn.Close

    Set rst = Nothing
    Set conn = Nothing

End Sub

How do I expand all columns in Excel spreadsheet?, Click where the row and column headers meet, this will select the entire sheet, like so: alt text. Then double-click any one of the column partition lines. I do this all  Select any cell in the column/row you want to autofit: To autofit multiple non-adjacent columns/rows, select one column or row and hold down the Ctrl key while selecting the other columns or rows. To autofit the entire sheet, press Ctrl + A or click the Select All button.

You can do this with worksheet formulas. If you have NAME'd ranges -- Animals, Fruits and Countries, the "trick" is to generate indexes into that array to provide all the various combinations.

For example:

=CEILING(ROWS($1:1)/(ROWS(Fruits)*ROWS(Countries)),1)

will generate a 1-based series of numbers that repeats for the number entries in Fruits * Countries -- which gives you how many rows you need for each animal.

=MOD(CEILING(ROWS($1:1)/ROWS(Countries),1)-1,ROWS(Fruits))+1

will generate a 1-based series that repeats each Fruit for the number of countries.

=MOD(ROWS($1:1)-1,ROWS(Countries))+1))

Generates a repeating sequence of 1..n where n is the number of countries.

Putting these into formulas (with some error checking)

D3:  =IFERROR(INDEX(Animals,CEILING(ROWS($1:1)/(ROWS(Fruits)*ROWS(Countries)),1)),"")
E3:  =IF(E3="","",INDEX(Fruits,MOD(CEILING(ROWS($1:1)/ROWS(Countries),1)-1,ROWS(Fruits))+1))
F3:  =IF(E3="","",INDEX(Countries,MOD(ROWS($1:1)-1,ROWS(Countries))+1))

Excel 2016: Modifying Columns, Rows, and Cells, Locate and click the Select All button just below the name box to select every cell in the worksheet. selecting all cells in a worksheet. Position the mouse over a row​  To change the default column width for the entire workbook, right-click a sheet tab, and then click Select All Sheets on the shortcut menu. On the Home tab, in the Cells group, click Format. Under Cell Size, click Default Width. In the Standard column width box, type a new measurement, and then click OK.

Actually, I want to modify my old answer. But, my new answer is fully differ from old answer. Because, old answer is for specific column and this one is for universal column. After answering the old answer, the questioner say new requirement which he want to do it in universal. For fixed column, we can think fixed looping and for infinite column, we need to think from another way. So, I also do it. And SO users also can see the code differences and I think, this will be helpful for beginners.

This new code is not so simple like the old one. If you want to know clearly about code, I suggested for debug the code in line by line.

Don't worry about the code. I already tested about it in step by step. It perfectly work for me. If it is not for you, please let me know. One things is that this code can cause error for blank row(which has no data). Because, currently, I not added checking for that.

Here is my universal approach for your problem:

Public Sub matchingCell()

    Dim startRawColumn, endRawColumn, startResultColumn, endResultColumn, startRow As Integer
    Dim index, row, column, containerIndex, tempIndex As Integer
    Dim columnCount, totalCount, timesCount, matchingCount, tempCount As Integer
    Dim isExist As Boolean
    Dim arrayContainer() As Variant

    'Actually, even it is for universal, we need to know start column and end column of raw data.
    'And also start row. And start column for write result.
    'I set them for my test data.
    'You need to modify them(startRawColumn, endRawColumn, startRow, startResultColumn).

    'Set the start column and end column for raw data
    startRawColumn = 1
    endRawColumn = 3

    'Set the start row for read data and write data
    startRow = 2

    'Set the start column for result data
    startResultColumn = 4

    'Get no of raw data column
    columnCount = endRawColumn - startRawColumn

    'Set container index
    containerIndex = 0

    'Re-create array container for count of column
    ReDim arrayContainer(0 To columnCount)

    With Sheets("sheetname")

        'Getting data from sheet

        'Loop all column for getting data of each column
        For column = startRawColumn To endRawColumn Step 1

            'Create tempArray for column
            Dim tempArray() As Variant

            'Reset startRow
            row = startRow

            'Reset index
            index = 0

            'Here is one things. I looped until to blank. 
            'If you want anymore, you can modify the looping type. 
            'Don't do any changes to main body of looping.

            'Loop until the cell is blank
            Do While .Cells(row, column) <> ""

                'Reset isExist flag
                isExist = False

                'Remove checking for no data
                If index > 0 Then

                    'Loop previous data for duplicate checking
                    For tempIndex = 0 To index - 1 Step 1

                        'If found, set true to isExist and stop loop
                        If tempArray(tempIndex) = .Cells(row, column) Then

                            isExist = True

                            Exit For

                        End If

                    Next tempIndex

                End If

                'If there is no duplicate data, store data
                If Not isExist Then

                    'Reset tempArray
                    ReDim Preserve tempArray(index)

                    tempArray(index) = .Cells(row, column)

                    'Increase index
                    index = index + 1

                End If

                'Increase row
                row = row + 1

            Loop

            'Store column with data
            arrayContainer(containerIndex) = tempArray

            'Increase container index
            containerIndex = containerIndex + 1

        Next column

        'Now, we got all data column including data which has no duplicate
        'Show result data on sheet

        'Getting the result row count
        totalCount = 1

        'Get result row count
        For tempIndex = 0 To UBound(arrayContainer) Step 1

            totalCount = totalCount * (UBound(arrayContainer(tempIndex)) + 1)

        Next tempIndex

        'Reset timesCount
        timesCount = 1

        'Get the last column for result
        endResultColumn = startResultColumn + columnCount

        'Loop array container
        For containerIndex = UBound(arrayContainer) To 0 Step -1

            'Getting the counts for looping
            If containerIndex = UBound(arrayContainer) Then

                duplicateCount = 1

                timesCount = totalCount / (UBound(arrayContainer(containerIndex)) + 1)

            Else

                duplicateCount = duplicateCount * (UBound(arrayContainer(containerIndex + 1)) + 1)

                timesCount = timesCount / (UBound(arrayContainer(containerIndex)) + 1)

            End If

            'Reset the start row
            row = startRow

            'Loop timesCount
            For countIndex = 1 To timesCount Step 1

                'Loop data array
                For index = 0 To UBound(arrayContainer(containerIndex)) Step 1

                    'Loop duplicateCount
                    For tempIndex = 1 To duplicateCount Step 1

                        'Write data to cell
                        .Cells(row, endResultColumn) = arrayContainer(containerIndex)(index)

                        'Increase row
                        row = row + 1

                    Next tempIndex

                Next index

            Next countIndex

            'Increase result column index
            endResultColumn = endResultColumn - 1

        Next containerIndex

    End With

End Sub

How to AutoFit in Excel: adjust columns and rows to match data size, This option expands the row vertically to hold multi-line or extra-tall text. To AutoFit column width, select one, several or all columns on the sheet, way to accommodate long text is to merge several cells into one big cell. Firstly type the formula of =(A1*3+8)/5 in Cell C1, and then drag the AutoFill Handle down to the bottom in Column C, then the formula of =(A1*3+8)/5 is applied in the whole Column C. If you need to apply it to the entire row, you can drag the AutoFill Handle to the far right.

Auto Expand Multiple Columns in Excel, Here we will go over when and how to auto expand multiple columns in Excel. the content in cells runs over cell margins making the data unreadable? in nice neat columns where each cell is expanded to the exact length  You can divide the contents of a cell and distribute the constituent parts into multiple adjacent cells. For example, if your worksheet contains a column Full Name, you can split that column into two columns—a First Name column and Last Name column.

Expanding the height of Excel cells - September 2016, The writer must physically adjust the length of each line. Also instead of the width of the cell automatically increasing, the text within that cell that wraps to As usual for things of this nature, go to format cells (or height or column or width of  I can do that by dragging the + sign which appears on the lower right of a cell to all the columns to copy the formula to the other cells. But this needs repetition every time you enter data in each row.

Help Online - Origin Help, Workbooks Worksheets and Worksheet Columns, Expand Workbooks Worksheets and Worksheet Columns When extending cell formulas to other cells by dragging, the syntax supports both The containing worksheet column Format must be set to Text & Numeric. All cell formulas begin with an equals sign "=": Working with rows, columns, and cells. In Excel, each worksheet is organized into a grid of rows, columns, and cells. Individual cells can also be grouped into ranges, which are just series of cells strung together. These items interact with each other to form the basic layout of an Excel document. Cell addresses

Comments

• Your description of your desired outcome is a bit vague to me. Could you clarify by uploading just a small sample of a few rows in excel. If I say you just want to copy column A,B, and C into E,F and G am I right then?
• Hello. I posted. Providing the link: filedropper.com/xmplso Please take a look.
• I added a printscreen in your question. Is there a reason why every summary row is there twice?
• Actually nope. Adding screenshot with modified example. Thank you for noticing that
• Does gorilla get combined with apple as well, or just with banana?
• This is the winner both for speed and thoroughness. Thanks for taking the time to explain and demonstrate the speed tests.
• The VBA you wrote for this is superfast and I plan on looking at it more closely; however, when I ran the macro based on the opportunities actual data set (5 Animals, 1000 Fruits, 10 Countries), I got a Run-time error 6: Overflow.
• Thanks for finding that. I had to wrap a division operation in brackets to gain mathematical precedence before a multiplication operation. See this. I'll be adding some error control and that math formula fix to this post in a short while.
• Minus 1 for merging cells. Kidding! (I do it all the time) I was trying to write this from scratch at 1:00 AM and I couldn't process the math. The line in the code that was previously throwing the exception is what I couldn't come up with.
• Hello Jeeped. Thank you for your effort. Seems your macro works perfectly for 3 data sets - I've tried already and it's really amazing. For 802x198x4 data set of 635184 rows were returned in nearly 5 secs! Extremely odd! Many thanks for it! Also tested for 4 and 5 columns and works perfectly. Just it seems the only limitation now is excel workbook
• @mysticous Do you think Excel's row limitation is ever going to be an issue for you when running this procedure? In other words, are there going to be circumstances when the output could be well over a million rows?
• Hello. Thank you for this solution. You can also do this as cross join, but let's say user is not accessible to solve this issue through MS SQL or Access
• See my update with Excel solution. Same concept of running non-join SQL statement.