CODEWITHSUNDEEP
vbafor-loopdynamic
Kate
Kate

Reputation: 23

Dynamic For Loops in VBA

Being quite new at VBA, I would appreciate your help for the following problem.

I am trying to create a table of 0's and 1's. I have a set of variables lets call them A,B,C which each can take respectively a,b,c number of different values (a,b,c are integers). I am trying to construct a matrix of all the different scenarios of combinations of these 3 variables. the value in the matrix would be 0 or 1. so if a=2, b=3,c=4, the table would look like that

sample matrix

I have written the code (inserted at the end).

However the table has to be dynamic as the number of variables (and the number of scenario for each variable) is not fixed. Can someone please help me?

Thank you

Sub table()
For i = 1 To 2
    For j = 1 To 3
        For k = 1 To 4
            For m = 1 To 9
                If m = i Then
                    Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 1
                ElseIf m = j + 2 Then
                    Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 1
                ElseIf m = k + 5 Then
                    Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 1
                Else
                    Worksheets("sheet1").Range("a1").Cells(12 * (i - 1) + 4 * (j - 1) + k, m).Value = 0
                End If
            Next m
        Next k
    Next j
Next i
End Sub

Upvotes: 1

Views: 3864

Answers (1)

Scott Craner
Scott Craner

Reputation: 152450

Try this:

Sub matrix()
Dim arr() As Variant
Dim totrow As Long
Dim j As Long
Dim t As Long
Dim p As Long
Dim x As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
'Set your array of numbers
arr = Array(2, 3, 4)
'If you want to refer to ranges on Sheet1 use:
'arr = Array(ws.Range("T1"), ws.Range("U1"), ws.Range("V1"))

totrow = 1
For j = LBound(arr) To UBound(arr)
    totrow = totrow * arr(j)
    x = x + arr(j)
Next j
ws.Range(ws.Cells(1, 1), ws.Cells(totrow, x)).Value = 0
p = 1

For j = UBound(arr) To LBound(arr) Step -1
    For t = 1 To totrow Step 1
        For i = 1 To arr(j)
            ws.Range(ws.Cells(t, x - arr(j) + i), ws.Cells(t + p - 1, x - arr(j) + i)).Value = 1
            t = t + p
        Next i
        t = t - 1
    Next t
    p = p * arr(j)
    x = x - arr(j)
Next j
End Sub

This will work for any value in the array or any number of integers in the array. The main limitation is the number of rows and columns on the sheet.

Upvotes: 2

Related Questions