I have written some code that transforms 2 way matrices into 1 way matrices. Although it's comfortable to use, it's very sluggish and slow in execution. Does anyone have any idea how to improve the performance? I'm aware that the same transformation can be done with standard formulas, but solely for learning reasons I would like to stick with vba.

How to use it - select whole matrix and execute the Sub.

Sub TwoToOneMatrix()
Set Mrange = Selection
colsX = Mrange.Columns.Count
rowsX = Mrange.Rows.Count
Set objects = Range(Mrange.Columns(1).Rows(2), Mrange.Columns(1).Rows(rowsX))
Set titleX = Range(Mrange.Columns(1).Rows(1), Mrange.Columns(1).Rows(1))
Set Rng = Application.InputBox("Select a range", "Obtain Range Object", Type:=8)

'Column 1
Rng.Value = titleX.Value
def = 1
For j = 2 To objects.Rows.Count + 1
    curCountry = Mrange.Columns(1).Rows(j)
    For i = 1 To colsX - 1
        Rng.Offset(def, 0).Value = curCountry
        def = def + 1
    Next i
Next j

'Column 2
def = 1
Rng.Offset(0, 1).Value = "Date"
For j = 1 To objects.Rows.Count
    For i = 2 To colsX
        curDate = Mrange.Columns(i).Rows(1)
        Rng.Offset(def, 1).Value = curDate
        def = def + 1
    Next i
Next j

'Column 3
Rng.Offset(0, 2).Value = "Values"
def = 1
For r = 2 To rowsX
    For c = 2 To colsX
        Rng.Offset(def, 2).Value = Mrange.Columns(c).Rows(r)
        def = def + 1
    Next c
Next r

End Sub
  • 2
    \$\begingroup\$ Could you clarify briefly what you mean by 2 and 1 way matrices? What does your data look like before and after? \$\endgroup\$ – Greedo Jul 26 '19 at 10:03

Your description is not very clear, but I see the usual suspects.


Always indent your code properly - this makes it easier to read, easier to pick out the logic loops and easier to maintain. In itself, it does not guarantee code correctness.

Option Explicit

Always put Option Explicit at the top of your modules.

Variable names

Use descriptive variable names. For what you tell us the code is intended to do, curDate and curCountry mean nothing. Neither does colsX, rowsX, def, Rng or Mrange.

Use arrays

Using arrays will improve your performance significantly. The reason for this improvement is that you stop switching between the VBA Engine and the Excel Engine (which comes at a cost) and you work purely in the one context. You also stop working with complex objects, which also incur an overhead.

The following is an example of how to adjust the code, but is not intended to be an accurate representation of your code.

Dim originalMatrix as Variant
originalMatrix = Selection.Value '<-- creates an array from the range values - only time to touch Excel
Dim title as String
title = CStr(originalMatrix(LBound(originalMatrix,1), LBound(originalMatrix,2))
Dim finalMatrix(,) As Variant '<-- or whatever type you want here
ReDim finalmatrix(UBound(originalMatrix,1) * UBound(originalMatrix,2),2)

' Adjust following loops to pick the right rows and columns.
For iterator1 = LBound(originalMatrix,1) To UBound(originalMatrix,1)
    For iterator2 = LBound(originalMatrix,2) To UBound(originalMatrix,2)
        finalMatrix(someCounter,1) = someValue1
        finalMatrix(someCounter,2) = someValue2
    Next iterator2
Next iterator1

'.... some code here to select output range and resize to match finalMatrix …
' … and then
outputRange.Value = finalMatrix '<--- again, a light touch against the Excel model

The use of LBound and UBound protect you against any confusion as to whether your array is 1-based or 0-based.You could store these in variables if you wanted the code to read a bit better.

| improve this answer | |
  • \$\begingroup\$ Thank you very much for providing me with the anwer. I'm going to improve my coding style accordingly to your remarks. \$\endgroup\$ – PsyduckDebugging Jul 27 '19 at 10:09

I've corrected my original code accordingly to @AJD tips. Now it's fully working and lightning fast.

Sub MatrixTransform()

Dim originalMatrix() As Variant
Dim finalMatrix() As Variant

originalMatrix() = Selection.Value
MatrixRows = 1 + (Selection.Rows.Count - 1) * (Selection.Columns.Count - 1)
ReDim finalMatrix(MatrixRows, 3)
finalMatrix(1, 1) = CStr(Selection.Rows(1).Columns(1))
finalMatrix(1, 2) = "Date"
finalMatrix(1, 3) = "Value"
k = 2

For i = 2 To Selection.Rows.Count
    For j = 2 To Selection.Columns.Count
        finalMatrix(k, 1) = originalMatrix(i, 1) 'object
        finalMatrix(k, 2) = originalMatrix(1, j)  'date
        finalMatrix(k, 3) = originalMatrix(i, j) 'value
        k = k + 1
    Next j
Next i

Set outputRng = Application.InputBox("Select range", "Obtain Range Object", Type:=8)
Range(outputRng, outputRng.Offset(MatrixRows, 3)).Value = finalMatrix

End Sub
| improve this answer | |

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.