How to run a for loop on a variable array in vba?

Question

I'm working on a 1066 x 592 matrix in Excel(say, M). I want to build a code that converts it appropriately to a 592 x 592 matrix(say, A). Matrix M is a binary matrix(cell values are either 0 or 1). Now, suppose for R1 of M, cells (R1, C1), (R1, C6), (R1, C400) and (R1, C550) are 1s and the rest are 0s. Then, I want to build an array of size 4(=no. of 1s in the row) that stores the values (1, 6, 400, 550) = (column nos. that contain 1s in R1). Then, I want a variable to loop only through these 4 values, so that, in matrix A, cells (1,6), (1,400), (1,550), (6,400), (6,550), (400,550), (6,1), (400,1), (550,1), (400,6), (550,6), (550,400) = (all possible permutations of length 2) add 1 to their previous values(initially 0).

I started by summing up all rows, hence the sum of each row is displayed in column no. 594 of that row. Then,

Sub ConnMat()

Dim i As Integer
Dim j As Integer
Dim r As Integer

For i = 2 To 1067

If Worksheets("Sheet3").Cells(i, 594).Value > 1 Then
Dim k As Integer
Dim k() as Integer
k = Cells(i, 594).Value    #no.of 1s in row i = length of array
For r = 1 To k
For j = 2 To 593
If Worksheets("Sheet3").Cells(i, j).Value = 1 Then
k(r) = j   #recording the column no containing 1 (=j) as the rth value of the array 
Next r
Next j




Worksheets("Sheet2").Cells(i, i).Value = Cells(i, j).Value + 1
End If
End If
Next i

I am a newbie and I have still not completed the code(unable to proceed because the array is not being created). Also, I looked at a few other posts like Assigning an array value to a variable inside a for loop in vba ...but could not gain value from them. Kindly help.

Is Matrix A be contructed from using all rows of matrix M or there will be more than one Matrix A? I have wrote my code on this assumption. — kitap mitap
– kitap mitap, Commented Apr 28, 2015 at 12:00
I mean, I construct one Matrix A using all rows of Matrix M creating a binary coordinate array of matrix A for each row of Matrix M. — kitap mitap
– kitap mitap, Commented Apr 28, 2015 at 12:10
I edited my code. I think you want to add 1's to first M matrix. — kitap mitap
– kitap mitap, Commented Apr 28, 2015 at 12:40

Tim Williams · Accepted Answer · 2015-04-26 22:21:59Z

Tested with a small dataset - seems to work OK:

Sub Tester()

    Const INPUT_ROWS As Long = 1066
    Const INPUT_COLS As Long = 592

    Dim r As Long, c As Long, c2 As Long, arr, sht As Worksheet
    Dim A(1 To INPUT_COLS, 1 To INPUT_COLS) As Long 'output array

    Set sht = Worksheets("Sheet1")

    'get the input values into a 2-D array
    arr = sht.Range("A1").Resize(INPUT_ROWS, INPUT_COLS).Value

    For r = 1 To INPUT_ROWS
        For c = 1 To INPUT_COLS
            If arr(r, c) = 1 Then
                'got a "1" - find others and combine pairs
                For c2 = (c + 1) To INPUT_COLS
                    If arr(r, c2) = 1 Then
                        'add pair to output array
                        A(c, c2) = A(c, c2) + 1
                        A(c2, c) = A(c2, c) + 1
                    End If
                Next c2
            End If
        Next c
    Next r

    'drop output array to worksheet
    sht.Range("A1").Offset(0, INPUT_COLS + 5).Resize( _
                       INPUT_COLS, INPUT_COLS).Value = A

End Sub

kitap mitap · Accepted Answer · 2015-04-28 13:38:41Z

Sheet3 is input (Matrix M) sheet and Sheet2 is the output (End Matrix M) sheet.

Private Sub ReMatrixM()
    Dim arrInput() As Variant
    Dim arrSumOfMatrixAs(592, 592) As Long

    Dim Ones() As Integer 'An array keeping indexes of columns which iclude 1.
    Dim iOnes As Integer
    Dim RowM As Integer, ColM As Integer, iRowA As Integer, iColA As Integer

    Dim shtM As Worksheet, shtM2 As Worksheet, cell As Variant

    '1. Take the values included in the sheet in an array
    Set shtM = Worksheets("Sheet3")
    arrInput = shtM.Range("B2").Resize(1066, 592)

    '2. We find columns which includes 1s
    '3. We will use this column indexes by binary combinations to fint the coordinates where 1s are to be added.

    'Now we cycle all rows of array
    For RowM = 1 To 1066 'Rows

        ReDim Ones(0)
        iOnes = 0

        'Now we cycle all colums for each row of array
        For ColM = 1 To 592 'Columns

            If arrInput(RowM, ColM) = 1 Then
                iOnes = iOnes + 1
                ReDim Preserve Ones(iOnes)
                Ones(iOnes) = ColM 'We are taking indexes of columns which includes one.
            Else
               arrInput(RowM, ColM) = 0
            End If

        Next

        If UBound(Ones) > 0 Then

            'For every row of arrInput add the values say cells of Matrix A (arrSumOfMatrixAs).
            For iRowA = 1 To UBound(Ones)
                For iColA = 1 To UBound(Ones)
                    arrSumOfMatrixAs(Ones(iRowA), Ones(iColA)) = arrSumOfMatrixAs(Ones(iRowA), Ones(iColA)) + 1
                Next
            Next

        End If

    Next

    'Than we add the sum of "matrix A"s to arrInput
    For RowM = 1 To 592
        For ColM = 1 To 592
            arrInput(RowM, ColM) = arrInput(RowM, ColM) + arrSumOfMatrixAs(RowM, ColM)
        Next
    Next

    Set shtM2 = Worksheets("Sheet2")
    'We reflect the arrInput to the sheet (Matrix M) at the end.
    shtM2.Range("B2").Resize(1066, 592) = arrInput

End Sub

First code first sum all Matrix A's values then add them to Matrix M. But if you want to do this row by row, I mean if it will be calculated the next Matrix A after the previous one would have been applicated, this is the code:

Private Sub ReMatrixM2()
    Dim arrInput() As Variant

    Dim Ones() As Integer 'An array keeping indexes of columns which iclude 1.
    Dim iOnes As Integer
    Dim RowM As Integer, ColM As Integer, iRowA As Integer, iColA As Integer

    Dim shtM As Worksheet, shtM2 As Worksheet, cell As Variant

    '1. Take the values included in the sheet in an array
    Set shtM = Worksheets("Sheet3")
    arrInput = shtM.Range("B2").Resize(1066, 592)

    '2. We find columns which includes 1s
    '3. We will use this column indexes by binary combinations to fint the coordinates where 1s are to be added.

    'Now we cycle all rows of array
    For RowM = 1 To 1066 'Rows

        ReDim Ones(0)
        iOnes = 0

        'Now we cycle all colums for each row of array
        For ColM = 1 To 592 'Columns

            If arrInput(RowM, ColM) > 0 Then 'See the difference
                iOnes = iOnes + 1
                ReDim Preserve Ones(iOnes)
                Ones(iOnes) = ColM 'We are taking indexes of columns which includes one.
            Else
               arrInput(RowM, ColM) = 0
            End If

        Next

        If UBound(Ones) > 0 Then

            'For every row of arrInput add the values in -say- cells of Matrix A to arrInput.
            For iRowA = 1 To UBound(Ones)
                For iColA = 1 To UBound(Ones)
                    arrInput(Ones(iRowA), Ones(iColA)) = arrInput(Ones(iRowA), Ones(iColA)) + 1
                Next
            Next

        End If

    Next

    Set shtM2 = Worksheets("Sheet2")
    'We reflect the arrInput to the sheet (Matrix M) at the end.
    shtM2.Range("B2").Resize(1066, 592) = arrInput

End Sub

Rupakshi Bhatia · Accepted Answer · 2015-04-29 12:29:16Z

Thanks @kitap mitap , @Tim Williams I'm learning! :) Divided my answer into 2 separate steps, and it worked well. Step 1:

Sub ComAct()


Dim i As Integer
Dim j As Integer
Dim r As Integer
Dim p As Integer
'Dim v() As Integer
Dim k As Integer


For i = 2 To 1067
p = 0
 If Worksheets("Sheet3").Cells(i, 594).Value > 1 Then
  k = Cells(i, 8).Value
  For j = 2 To 593
   If Worksheets("Sheet3").Cells(i, j).Value = 1 Then
    p = p + 1
    Worksheets("Sheet4").Cells(i - 1, p).Value = j
   End If
  Next j
 End If
Next i
End Sub

Step 2:

Sub ConnMat()
Worksheets("Sheet2").Range("B2:VU593").Value = 0

Dim i As Integer
Dim v As Integer
Dim j As Integer
Dim k As Integer

For i = 1 To 1067
 v = Worksheets("Sheet4").Cells(i, 30).Value
  If v > 1 Then
   For j = 1 To v
   For k = 1 To v
   If j <> k Then
   Worksheets("Sheet2").Cells(Worksheets("Sheet4").Cells(i, j).Value, Worksheets("Sheet4").Cells(i, k).Value).Value = Worksheets("Sheet2").Cells(Worksheets("Sheet4").Cells(i, j).Value, Worksheets("Sheet4").Cells(i, k).Value).Value + 1
   End If
   Next k
   Next j
   End If
   Next i
End Sub

Collectives™ on Stack Overflow

How to run a for loop on a variable array in vba?

3 Answers 3

Comments

1 Comment

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related