CODEWITHSUNDEEP
excelvba
user2081581
user2081581

Reputation: 13

How to Re-dimension array in the given code below

I need to expand the array as per below. Searched for answers but none seem to help as below code.

Sub MakeOneColumn()

Dim vaCells As Variant
Dim vOutput() As Variant
Dim i As Long, j As Long
Dim lRow As Long

If TypeName(Selection) = "Range" Then
    If Selection.Count > 1 Then
        If Selection.Count <= Selection.Parent.Rows.Count Then
            vaCells = Selection.Value

            ReDim vOutput(1 To UBound(vaCells, 1) * UBound(vaCells, 2), 1 To 1)

            For j = LBound(vaCells, 2) To UBound(vaCells, 2)
                For i = LBound(vaCells, 1) To UBound(vaCells, 1)
                    If Len(vaCells(i, j)) > 0 Then
                        lRow = lRow + 1
                        vOutput(lRow, 1) = vaCells(i, j)
                    End If
                Next i
                lRow = lRow + 1
            Next j

            Selection.ClearContents
            Selection.Cells(1).Resize(lRow).Value = vOutput
        End If
    End If
End If

End Sub

The above code works without the added row "lRow = lRow + 1". However, I need a blank row for each column in the array. With the added row I get a runtime error 9, subscript out of range.

Upvotes: 1

Views: 154

Answers (2)

user2063626
user2063626

Reputation:

Kindly change your redim statement to below

  ReDim vOutput(1 To (UBound(vaCells, 1) * UBound(vaCells, 2)) + UBound(vaCells, 2), 1 To 1)

Upvotes: 1

chuff
chuff

Reputation: 5866

You are getting the error because you are iterating lrow twice, once in the i loop and once in the j loop. If you check, you should discover that the error only occurs when there are values in all the cells in the selection.

The fix is set the initial value oflrow outside of the j and i loops and then iterate after you make the assignment of the current cell's value to vOutput. It looks like this:

  lRow = 1
  For j = LBound(vaCells, 2) To UBound(vaCells, 2)
      For i = LBound(vaCells, 1) To UBound(vaCells, 1)
          If Len(vaCells(i, j)) > 0 Then
              vOutput(lRow, 1) = vaCells(i, j)
              lRow = lRow + 1
          End If
      Next i
  Next j

In passing, I would note that you don't need the TypeName test because a selection is always of type Range.

Upvotes: 0

Related Questions