How to create repeated cell values

Requirement:

The user is trying to automatically generate some data. Basically for any set of given numbers, the macro should create repeated numbers in two columns (just like shown in table below).

Example: The user has 3 values 1,2,4 in column A, and need sthe macro to create 9 rows of data with each value repeating for the input data. The values can be 100 of records that need to be repeated 100x100 for each value.

1	1
1	2
1	4
2	1
2	2
2	4
4	1
4	2
4	4

The data can be read from column A. The rearranged data in columns B and C. Please see the table. This example is using consecutive numbers in Column A, but the macro should work with any range of numbers.

Column A	Column B	Column C
1	1	1
2	1	2
3	1	3
4	1	4
5	1	5
	2	1
	2	2
	2	3
	2	4
	2	5
	3	1
	3	2
	3	3
	3	4
	3	5
	4	1
	4	2
	4	3
	4	4
	4	5
	5	1
	5	2
	5	3
	5	4
	5	5

For each value in column A their should be data in Column in B and C. Column C is just repeat of data in column A. In the example above there are 'N' number of records (5 in this example). For each of these records the user needs NxN rows of data (25) in Column B and C.

Column B will show the first record in Column A N times and the data in Column C will show Column A data N times.

Next Column B will show the second record N times and Column C will show Column A data N times..and it will keep repeating till it reaches NxN number of records.

Cell A1 is a header with data starting at A2.

Data	Result	Result
7	7	7
12	7	12
100	7	100
506	7	506
	12	7
	12	12
	12	100
	12	506
	100	7
	100	12
	100	100
	100	506
	506	7
	506	12
	506	100
	506	506

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1213894-how-to-create-repeated-cell-values

Solution:

Code:

Sub RearrangeData()
    Dim x, y, e, i As Long, ii As Long
    
    With ActiveSheet
        x = .Cells(1).CurrentRegion.Columns(1)
        With CreateObject("scripting.dictionary")
            For i = 2 To UBound(x, 1)
                If x(i, 1) <> "" Then .Add x(i, 1), Nothing
            Next
            ReDim y(1 To .Count * .Count, 1 To 2)
            For Each e In .keys
                For i = 1 To .Count
                    ii = ii + 1: y(ii, 1) = e
                Next
            Next
            ii = 0
            For i = 1 To UBound(y, 1) Step .Count
                For Each e In .keys
                    ii = ii + 1: y(ii, 2) = e
                Next
            Next
        End With
        With .[b2]
            .Resize(1100, 2).Clear
            .Resize(UBound(y, 1), 2) = y
        End With
    End With
    
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by KjBox.