I generate a set of data based off every combination of inputs. The source range that's inputs requires headers to identify the parameters. In its present state I'm not content as it's not as straightforward as I'd like it to be. Specifically the module variables can be cleaned up but I'm not seeing how.
A simple example with 2 columns
---------------------
| Column1 | Column2 |
|---------|---------|
| A | 1 |
| B | 2 |
| C | 3 |
---------------------
generates
---------------------
| Column1 | Column2 |
|---------|---------|
| A | 1 |
| A | 2 |
| A | 3 |
| B | 1 |
| B | 2 |
| B | 3 |
| C | 1 |
| C | 2 |
| C | 3 |
---------------------
Adding a 3 column input table
-------------------------------
| Column1 | Column2 | Column3 |
|---------|---------|---------|
| A | 1 | F1 |
| B | 2 | F2 |
| C | 3 | F3 |
| | | F4 |
-------------------------------
generates
-------------------------------
| Column1 | Column2 | Column3 |
|---------|---------|---------|
| A | 1 | F1 |
| A | 1 | F2 |
| A | 1 | F3 |
| A | 1 | F4 |
| A | 2 | F1 |
. . . . . . . . . . . . . . .
| C | 2 | F4 |
| C | 3 | F1 |
| C | 3 | F2 |
| C | 3 | F3 |
| C | 3 | F4 |
-------------------------------
and so on.
The class module InputColumn
is used to help compartmentalize the logic for each column and its corresponding max depth being equivalent to CountOfValues
.
'@PredeclaredId
'@Folder("ParametricSweep.Model")
Option Explicit
Private Type THelper
ColumnIndex As Long
Values As Variant
Identifier As String
End Type
Private this As THelper
Public Property Let Values(ByVal Value As Variant)
this.Values = Value
End Property
Public Property Get Values() As Variant
Values = this.Values
End Property
Public Property Get CountOfValues() As Long
CountOfValues = UBound(Values) - LBound(Values) + 1
End Property
Public Property Let Identifier(ByVal Value As String)
this.Identifier = Value
End Property
Public Property Get Identifier() As String
Identifier = this.Identifier
End Property
Public Function Self() As InputColumn
Set Self = Me
End Function
Public Function Create(ByVal ColumnIndex As Long, ByVal sourceArea As Range) As InputColumn
Dim populatedCells As Range
Set populatedCells = sourceArea.SpecialCells(XlCellType.xlCellTypeConstants)
With New InputColumn
.Identifier = populatedCells(1, 1).Value2
.Values = Application.WorksheetFunction.Transpose(populatedCells.Offset(1).Resize(populatedCells.Rows.Count - 1).Value2)
Set Create = .Self
End With
End Function
The sweep of values is generated by populating the inputColumns()
array then stepping into PopulateArray 1
for the first (topmost) level. After the call to PopulateArray
it recursively descends one level deeper until it's populating the last column. As each loop returns it increments the array recursionInputColumnPopulationIndex()
that identifies which element should populated for the corresponding recursion depth.
Option Explicit
Private parentArray() As Variant
Private inputColumns() As InputColumn
Private maxRecursionDepth As Long
Private recursionInputColumnPopulationIndex() As Long
Private populationRow As Long
Public Sub TestRecursive()
Dim foo As Variant
foo = RecursiveParametricSweep(Sheet1.Range("C5").CurrentRegion, True)
Dim bar As Variant
bar = RecursiveParametricSweep(Sheet1.Range("C16").CurrentRegion, False)
End Sub
Public Function RecursiveParametricSweep(ByVal inputSourceArea As Range, ByVal includeHeader As Boolean) As Variant
maxRecursionDepth = inputSourceArea.Columns.Count
ReDim inputColumns(1 To maxRecursionDepth)
ReDim recursionInputColumnPopulationIndex(1 To maxRecursionDepth)
PopulateInputColumns inputSourceArea
Dim rowCount As Long
rowCount = GetRowCount(inputColumns)
If includeHeader Then
ReDim parentArray(0 To rowCount, 1 To maxRecursionDepth)
Dim headerRow As Long
headerRow = LBound(parentArray)
Dim headerColumn As Long
For headerColumn = LBound(inputColumns) To UBound(inputColumns)
parentArray(headerRow, headerColumn) = inputColumns(headerColumn).Identifier
Next
populationRow = LBound(parentArray) + 1
Else
ReDim parentArray(1 To rowCount, 1 To maxRecursionDepth)
populationRow = LBound(parentArray)
End If
PopulateArray 1, includeHeader
RecursiveParametricSweep = parentArray
End Function
Private Sub PopulateArray(ByVal recursionDepth As Long, ByVal includeHeader As Boolean)
Dim populateElementCount As Long
For populateElementCount = 1 To inputColumns(recursionDepth).CountOfValues
If recursionDepth < maxRecursionDepth Then
PopulateArray recursionDepth + 1, includeHeader
recursionInputColumnPopulationIndex(recursionDepth) = recursionInputColumnPopulationIndex(recursionDepth) + 1
Else
Dim columnPopulationIndex As Long
For columnPopulationIndex = recursionDepth To 1 Step -1
parentArray(populationRow, columnPopulationIndex) = inputColumns(columnPopulationIndex).Values(recursionInputColumnPopulationIndex(columnPopulationIndex) + 1)
Next
recursionInputColumnPopulationIndex(recursionDepth) = recursionInputColumnPopulationIndex(recursionDepth) + 1
populationRow = populationRow + 1
End If
Next
recursionInputColumnPopulationIndex(recursionDepth) = 0
End Sub
Private Function GetRowCount(ByRef inputColumns() As InputColumn) As Long
GetRowCount = 1
Dim depthCounter As Long
For depthCounter = LBound(inputColumns) To UBound(inputColumns)
GetRowCount = GetRowCount * inputColumns(depthCounter).CountOfValues
Next
End Function
Private Sub PopulateInputColumns(ByVal inputSourceArea As Range)
Dim populateInputColumnsCounter As Long
For populateInputColumnsCounter = LBound(inputColumns) To UBound(inputColumns)
Set inputColumns(populateInputColumnsCounter) = InputColumn.Create(populateInputColumnsCounter, inputSourceArea.Columns(populateInputColumnsCounter))
Next
End Sub
```