VBA: completing a matrix - excel

Question

I have a 3 by 3 matrix, where elements (1,1), (2,1), (2,2), (3,1), (3,2), (3,3) are given:
X . .
X X .
X X X
I need to write a program that writes out the missing elements, where (1,2)=(2,1), (1,3)=(3,1) and (2,3)=(3,2). I have written the following code:
Function kiegeszito(a)
For i = 1 To 3
For j = 1 To 3
If i < j Then
a(i, j) = a(j, i)
Else
a(i, j) = a(i, j)
End If
Next j
Next i
kiegeszito = a
End Function
However, this does not seem to work, could anybody help me why is this not working?

Answer 1

Just remove the Else condition:
Function kiegeszito(a)
For i = 1 To 3
For j = 1 To 3
If i < j Then a(i, j) = a(j, i)
Next j
Next i
kiegeszito = a
End Function

Answer 2

Get twin data in 2-dim matrix avoiding extra n*(n-1)/2 condition checks
The following approach
reduces the number of unnecessary condition checks by incrementing the 2nd loop starts
accepts any wanted base of 2-dim data:
Sub CompleteMatrix(ByRef data)
'count row|=column elements
Dim cnt As Long: cnt = UBound(data) - LBound(data) + 1
'fill missing twin data (identified by inverted indices)
Dim i As Long, j As Long
For i = LBound(data) To cnt - 1
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'next column starts from incremented row index
'(thus avoiding n*(n-1)/2 IF-conditions)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For j = i + 1 To UBound(data, 2)
data(i, j) = data(j, i) ' assign twin data
Next j
Next i
End Sub
An example call creating e.g. a 1-based 2-dim datafield array might be
Sub ExampleCall()
Dim v: v = Tabelle3.Range("A1:C3").Value
CompleteMatrix v
End Sub
Further link
A practical example using such a mirrored array might be a distance array; a related post demonstrates how to apply the FilterXML() function thereon.

Answer 3

Fill Array
Using a method (fillArray) you could modify the array 'in place':
The Code
Option Explicit
Sub fillArrayTEST()
Dim Data As Variant: Data = Range("A1:C3").Value
debugPrint2D Data
fillArray Data
debugPrint2D Data
End Sub
Sub fillArray(ByRef Data As Variant)
Dim cCount As Long: cCount = UBound(Data, 2)
Dim i As Long, j As Long
For i = 1 To UBound(Data, 1)
For j = 1 To cCount
If i < j Then Data(i, j) = Data(j, i)
Next j
Next i
End Sub
Sub debugPrint2D(ByVal Data As Variant)
Dim i As Long, j As Long
For i = LBound(Data, 1) To UBound(Data, 1)
For j = LBound(Data, 2) To UBound(Data, 2)
Debug.Print "[" & i & "," & j & "]", Data(i, j)
Next j
Next i
End Sub
A Homage to T.M.'s Brilliant Solution
Sub completeMatrix(ByRef Data As Variant)
Dim rLower As Long: rLower = LBound(Data, 1)
Dim cLower As Long: cLower = LBound(Data, 2)
Dim iDiff As Long: iDiff = cLower - rLower
Dim cStart As Long: cStart = iDiff + 1
Dim cUpper As Long: cUpper = UBound(Data, 2)
Dim r As Long, c As Long
For r = rLower To UBound(Data, 1) - rLower
For c = cStart + r To cUpper
Data(r, c) = Data(c - iDiff, r + iDiff)
Next c
Next r
End Sub
Sub completeMatrixTEST()
Dim Data As Variant: ReDim Data(0 To 2, 2 To 4)
Data(0, 2) = 1
Data(1, 2) = 2
Data(1, 3) = 3
Data(2, 2) = 4
Data(2, 3) = 5
Data(2, 4) = 6
debugPrint2D Data
completeMatrix Data
'Range("G1").Resize(UBound(Data, 1) - LBound(Data, 1) + 1, _
UBound(Data, 2) - LBound(Data, 2) + 1).Value = Data
Debug.Print
debugPrint2D Data
End Sub