Combinations of 3 from 16 numbers pool with unique product

[libelouli]

Hi.
I have these 16 numbers : 2 , 3 , 4 , 5 , 6 , 7 , 8 , 10 , 15 , 20 , 25 , 30 , 40 , 50 , 100 , 500 and I want to display in excel VBA all the combinations of threes.The product of threes I want to be unique.I use Excel 2010.
Example :
Column A - Column B - Colmn C - Column D
2 3 4 24
2 3 5 30
2 3 6 36
2 3 7 42 ...etc,etc.Column D resaults must be unique.
I found with an online calculator that all combinations is 560.So I asume that many of them will have the same product of three which I don't want.
Can anyone help how to manage this?
Thanks in advanced for your time.

 

[libelouli]

Try this (assuming no repetitions).

Sub GenerateCombinations()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)
    Dim inputRange As Range
    Dim outputArray() As Variant
    Dim i As Long, j As Long, k As Long
    Dim n As Long
    Dim numbers() As Variant
    Dim outputRow As Long
    Dim totalCombinations As Long
   
    'Assuming the numbers are in column A starting from A1
    numbers = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value
    n = UBound(numbers, 1)

    totalCombinations = (n * (n - 1) * (n - 2)) / 6
    ReDim outputArray(1 To totalCombinations, 1 To 4)
    outputRow = 1
    For i = 1 To n - 2
        For j = i + 1 To n - 1
            For k = j + 1 To n
                outputArray(outputRow, 1) = numbers(i, 1)
                outputArray(outputRow, 2) = numbers(j, 1)
                outputArray(outputRow, 3) = numbers(k, 1)
                outputArray(outputRow, 4) = numbers(i, 1) * numbers(j, 1) * numbers(k, 1)
                outputRow = outputRow + 1
            Next k
        Next j
    Next i
    'Output
    ws.Range("B1").Resize(totalCombinations, 4).Value = outputArray
End Sub

Thanks fo the code.
I get a runtime error 13 type mismatch on LINE numbers = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value
I put the numbers on A column as commented.

 

[Cubist]

Did you change the "1" to your sheet name?

Set ws = ThisWorkbook.Sheets(1)

The values should go down column A like this.

Book1
	A
1	2
2	3
3	4
4	6
5	7
6	8
Sheet1

 

[libelouli]

Did you change the "1" to your sheet name?

Set ws = ThisWorkbook.Sheets(1)

The values should go down column A like this.

Book1
	A
1	2
2	3
3	4
4	6
5	7
6	8
Sheet1

I changed the 1 with Sheet1 (the name of my sheet) and now I get highlighted the Set ws = ThisWorkbook.Sheets(Sheet1).
The column A values is correct.I don't know what is wrong with the sheet name.

 

[Cubist]

I changed the 1 with Sheet1 (the name of my sheet) and now I get highlighted the Set ws = ThisWorkbook.Sheets(Sheet1).
The column A values is correct.I don't know what is wrong with the sheet name.

They need to be in quotes "Sheet1"

 

[libelouli]

They need to be in quotes "Sheet1"

That worked.Thanks a lot.
Thank you all guys for the help.I appreciate.