How to add a counter column to existing matrix in VBA?

Question

How to get a new matrix in VBA with a counter value in the first "column". Suppose we have a VBA matrix which values we get from cells. The value of A1 cell is simply "A1".

Dim matrix As Variant
matrix = Range("A1:C5").value

Input matrix:

+----+----+----+
| A1 | B1 | C1 |
+----+----+----+
| A2 | B2 | C2 |
+----+----+----+
| A3 | B3 | C3 |
+----+----+----+
| A4 | B4 | C4 |
+----+----+----+
| A5 | B5 | C5 |
+----+----+----+

I would like to get new matrix with the counter value in the first column of VBA matrix.

Here are desired results:

+----+----+----+----+
|  1 | A1 | B1 | C1 |
+----+----+----+----+
|  2 | A2 | B2 | C2 |
+----+----+----+----+
|  3 | A3 | B3 | C3 |
+----+----+----+----+
|  4 | A4 | B4 | C4 |
+----+----+----+----+
|  5 | A5 | B5 | C5 |
+----+----+----+----+

One way to do it is looping. Would there be any other more elegant way to do it? We are dealing here with large data sets, so please mind the performance.

Answer 1

If your main concern is the performance, then use Redim Preserve to add a new column at the end and use the OS API to shift each column directly in the memory:

Private Declare PtrSafe Sub MemCpy Lib "kernel32" Alias "RtlMoveMemory" ( _
  ByRef dst As Any, ByRef src As Any, ByVal size As LongPtr)

Private Declare PtrSafe Sub MemClr Lib "kernel32" Alias "RtlZeroMemory" ( _
  ByRef src As Any, ByVal size As LongPtr)


Sub AddIndexColumn()
  Dim arr(), r&, c&
  arr = [A1:F1000000].Value

  ' add a column at the end
  ReDim Preserve arr(LBound(arr) To UBound(arr), LBound(arr, 2) To UBound(arr, 2) + 1)

  ' shift the columns by 1 to the right
  For c = UBound(arr, 2) - 1 To LBound(arr, 2) Step -1
    MemCpy arr(LBound(arr), c + 1), arr(LBound(arr), c), (UBound(arr) - LBound(arr) + 1) * 16
  Next
  MemClr arr(LBound(arr), LBound(arr, 2)), (UBound(arr) - LBound(arr) + 1) * 16

  ' add an index in the first column
  For r = LBound(arr) To UBound(arr)
    arr(r, LBound(arr, 2)) = r
  Next

End Sub

Answer 2

Method 1

This method inserts cells to the left of the range and set the new cells formula to calculate the counter =ROWS($A$1:$A5) . Note: this pattern is also used to calculate a running total.

Usage

InsertCounter Worksheets("Sheet1").Range("A1:C5")

Sub InsertCounter(Target As Range)
    Dim counterCells As Range
    Target.Columns(1).Insert Shift:=xlToRight
    Set counterCells = Target.Columns(1).Offset(0, -1)
    counterCells.Formula = "=Rows(" & counterCells.Cells(1, 1).Address(True, True) & ":" & counterCells.Cells(1, 1).Address(False, True) & ")"
End Sub

Method 2

This method copies the Ranges' Values into an array, creates a new array with 1 extra column and then copies the data and a counter over to the new array. The difference in this Method is that it doesn't insert any cells.

Usage

AddCounterToMatrix Worksheets("Sheet1").Range("A1:C5")

Sub AddCounterToMatrix(Target As Range)
    Dim x As Long, y As Long
    Dim Matrix1 As Variant, NewMatrix1 As Variant
    Matrix1 = Target.Value

    ReDim NewMatrix1(LBound(Matrix1) To UBound(Matrix1), LBound(Matrix1, 2) To UBound(Matrix1, 2) + 1)

    For x = LBound(Matrix1) To UBound(Matrix1)
        NewMatrix1(x, 1) = x - LBound(Matrix1) + 1
        For y = LBound(Matrix1, 2) To UBound(Matrix1, 2)
            NewMatrix1(x, y + 1) = Matrix1(x, y)
        Next
    Next

    Target.Resize(UBound(NewMatrix1) - LBound(Matrix1) + 1, UBound(NewMatrix1, 2) - LBound(NewMatrix1, 2) + 1).Value = NewMatrix1

End Sub

Answer 3

using a Dynamic variant is fast.

Sub test()
    Dim matrix As Variant, newMatrix()
    Dim i As Long, n As Long, c As Long, j As Long
    matrix = Range("A1:C5").Value
    n = UBound(matrix, 1)
    c = UBound(matrix, 2)
    ReDim newMatrix(1 To n, 1 To c + 1)
    For i = 1 To n
        newMatrix(i, 1) = i
        For j = 2 To c + 1
            newMatrix(i, j) = matrix(i, j - 1)
        Next j
    Next i
    Range("a1").Resize(n, c + 1) = newMatrix
End Sub

Answer 4

excel based solution are ok for u?

Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1") = "1"
Range("A2") = "2"
Range("A1:A2").Select
Selection.AutoFill Destination:=Range("A1:A5")

Dim matrix As Variant
matrix = Range("A1:D5").Value

Answer 5

Why not a compromise between household remedies and pure array scripting by inserting a temporary column and doing the rest within the array's first column.

Code

Option Explicit

Public Sub test_CounterCol2()
Dim matrix As Variant, newMatrix()
Dim i As Long, n As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("CounterCol")    ' <== user defined sheet
' a) insert column temporarily]
  ws.Columns("A:A").Insert Shift:=xlToRight
' b) get values
  matrix = ws.Range("A1:D5").value
' c) only loop within array counter column
  n = UBound(matrix, 1)
  For i = 1 To n
        matrix(i, 1) = i
  Next i
' d) delete temporary insertion
  ws.Columns("A:A").Delete (xlShiftToLeft)

End Sub

Additional note: Maybe you can find something via API (CopyMemory).