Transitive closure using warshall algirithm in excel vba

[sandy1234]

Sub sumvector()
Dim n, k, i, j, wij As Integer
'w = Range("A1:C3").Rows.Count
n = Range("A1:C3").Rows.Count
For k = 1 To n
For i = 1 To n
For j = 1 To n
wij = Range("A1:C3").Cells(i, j) + [ Range("A1:C3").Cells(i, k) + Range("A1:C3").Cells(k, i)]
Next j
Next i
Next k


Range("E1:G3").Value = wij


End Sub
'it should take a 3*3 matrix and do its transitive closure
its not working,could you help me please

 

[RickXL]

Hi,

I had a couple of problems. First I know nothing about Warshall Algorithms and I could not work out what your code was trying to do.

So I gave myself a quick Internet course and started again with the code. Consequently, this might not be exactly what you were expecting.

My macro starts in cell A1 and determines data within the CurrentRegion. So if you have entered a 3x3 matrix starting in A1 it will use that. Then it sets up an output range of the same size.

The algorithm then runs for the first step. It then moves the input range so that it is looking at the previous output then moves the new output range downwards. That is, it gives all the intermediate results.

If the original range was a 4x4 matrix it makes everything bigger and moves the output ranges down appropriately. This means you can put in different sized arrays.

Have a look and see what you think:

Sub Test()

    Dim r1 As Range, r2 As Range
    Dim n As Long, i As Long, j As Long, k As Long
    
    Set r1 = Range("A1").CurrentRegion
    n = r1.Rows.Count
    Set r2 = r1.Offset(n + 1).Resize(n, n)

    For k = 1 To n
        For i = 1 To n
            For j = 1 To n
                r2(i, j) = r1(i, j) Or (r1(i, k) And r1(k, j))
            Next
        Next
        Set r1 = r1.Offset(n + 1).Resize(n, n)
        Set r2 = r2.Offset(n + 1).Resize(n, n)
    Next

End Sub

 

[RickXL]

Hi,

My code can be simplified slightly. There is no need to resize the ranges - they are already the right size.

Also, I decided to add some more details which I hope will be useful. The macro code needs to be pasted in to a new Macro Module in the VB Editor.

The screen print shows the starting matrix at at the top left and the final matrix at the top right. The macro actually leaves the final matrix at the bottom left so I just copied it to the top to get everything on the same page. You have to make the diagram yourself. The macro does not do that (yet!).

Sub Test()

    Dim r1 As Range, r2 As Range
    Dim n As Long, i As Long, j As Long, k As Long
    
    Set r1 = Range("A1").CurrentRegion
    n = r1.Rows.Count
    Set r2 = r1.Offset(n + 1)

    For k = 1 To n
        For i = 1 To n
            For j = 1 To n
                r2(i, j) = r1(i, j) Or (r1(i, k) And r1(k, j))
            Next
        Next
        Set r1 = r1.Offset(n + 1)
        Set r2 = r2.Offset(n + 1)
    Next

End Sub

Starting position:

Excel 2013
	A	B	C	D	E	F	G	H
1	0	1	0	0	0	0	1	0
2	1	0	0	0	0	0	1	1
3	1	1	0	0	0	1	0	0
4	0	0	0	0	0	1	0	0
5	0	0	0	0	0	0	0	1
6	0	0	1	0	0	0	1	0
7	0	0	0	0	0	0	0	0
8	1	0	0	0	0	0	0	0
Sheet2

 

[sandy1234]

Thanks