Home Ask Login Register

Developers Planet

Your answer is one click away!

Kate February 2016

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

Answers


Scott Craner February 2016

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.

Post Status

Asked in February 2016
Viewed 2,389 times
Voted 8
Answered 1 times

Search




Leave an answer


Quote of the day: live life