I am trying to write an excel macro to generate a list of possible combinations.
I have a fixed series of values in different columns
A, B, C, D - each in it's own column.
I have a list of new values to replace with A, B, C or D and would like to generate all of the combinations.
List of new values ie 1, 2, 3, 4
I would get a total of 16 different combinations
For example,
1BCD
2BCD
3BCD
4BCD
A1CD
A2CD
A3CD
...
ABC1
ABC2
ABC3
ABC4
I'm not sure if this is clear but I would like to generate combinations by iterating through each column to generate the possible combinations with the new values inserted.
You can use the following to cross join two different ranges. It will handle ranges of any size and write the crossjoined combinations to a target sheet that you specify.
In the example below, I have defined two named ranges: newValues
and fixedValues
. Both of these ranges are on Sheet1
. I then loop through the ranges and write all combinations to Sheet2
.
Sub CrossJoinMyRanges()
Dim ws As Worksheet
Dim newValues As Range
Dim cell As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
Set newValues = ws.Range("newValues")
' loop through the new values
For Each cell In newValues
Call ReplaceMe(cell.Value, ws)
Next cell
End Sub
Sub ReplaceMe(replacement As String, ws As Worksheet)
Dim fixedValues As Range
Dim cell As Range
Set fixedValues = ws.Range("fixedValues")
' outer loop through fixedValues
For Each cell In fixedValues
Call PrintReplacedValues(cell.Row, replacement)
Next cell
End Sub
Sub PrintReplacedValues(rowNumber As Long, replacement As String)
Dim wb As Workbook
Dim src As Worksheet
Dim tgt As Worksheet
Dim fixedValues As Range
Dim cell As Range
Dim printMe As String
Dim x As Long, y As Long
Set wb = ThisWorkbook
Set src = wb.Sheets("Sheet1")
Set tgt = wb.Sheets("Sheet2")
Set fixedValues = src.Range("fixedValues")
y = 1
x = tgt.Range("A" & tgt.Rows.Count).End(xlUp).Row + 1
' inner loop through fixed values
For Each cell In fixedValues
' replace the fixed value with the replacement
' if the loops intersect
If cell.Row = rowNumber Then
printMe = replacement
Else
' otherwise keep the fixed value
printMe = cell
End If
' write to the target sheet
tgt.Cells(x, y).Value = printMe
y = y + 1
Next cell
End Sub
There are a few similar questions with alternative solutions that you can also look into if my approach isn't what you were after:
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.