Removing Elements from Collection

[smpatty08]

I am trying to remove empty elements from a Collection. Here is the code I have so far.

Sub T()
Dim i As Integer
Dim Altered As New Collection
 
Altered.Add Range(Cells(12, 2), Cells(19, 12)).FormulaR1C1
 
For i = 1 To Altered.Count
    If Altered.Item(i) = "" Then
        Altered.Remove i
    End If
Next i
 
End Sub

From the Locals window here is what Altered looks like:
Altered

Item 1(1)
Item 1(2)
Item 1(3)
Item 1(4)​

Item 1(4,1) ""
Item 1(4,2) ""
Item 1(4,3) ""
Item 1(4,4) ""
Item 1(4,5) ""
Item 1(4,6) ""
Item 1(4,7) ""
Item 1(4,8) ""
Item 1(4,9) ""
Item 1(4,10) ""
Item 1(4,11) ""​

Item 1(5)
Item 1(6)
Item 1(7)
Item 1(8)
Item 1(9)
Item 1(10)
Item 1(11)​

I would like to remove all elements of Item 1(4) so I can paste the collection back into Range(Cells(12, 2), Cells(19, 12))

My Table looks like this
Start:

A	B	C	D	E	F	G	H	I	J	K	L
12	1	1	1	1	1	1	1	1	1	1	1
13	1	1	1	1	1	1	1	1	1	1	1
14	1	1	1	1	1	1	1	1	1	1	1
15
16	1	1	1	1	1	1	1	1	1	1	1
17	1	1	1	1	1	1	1	1	1	1	1
18	1	1	1	1	1	1	1	1	1	1	1
19	1	1	1	1	1	1	1	1	1	1	1

<tbody>
</tbody>

I want it to look like this when done:

A	B	C	D	E	F	G	H	I	J	K	L
12	1	1	1	1	1	1	1	1	1	1	1
13	1	1	1	1	1	1	1	1	1	1	1
14	1	1	1	1	1	1	1	1	1	1	1
15	1	1	1	1	1	1	1	1	1	1	1
16	1	1	1	1	1	1	1	1	1	1	1
17	1	1	1	1	1	1	1	1	1	1	1
18	1	1	1	1	1	1	1	1	1	1	1
19

<tbody>
</tbody>

Any help is appreciated!

 

[mikerickson]

I would not use a collection for that purpose. And your goal is not clear.
Do you want to remove each cell that is empty
or each row where every cell in the row is empty
or each row where any of the cells in that row are empty.

One quick approach might be

Range(Cells(12, 2), Cells(19, 12)).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp

 

[smpatty08]

I would not use a collection for that purpose. And your goal is not clear.
Do you want to remove each cell that is empty
or each row where every cell in the row is empty
or each row where any of the cells in that row are empty.

One quick approach might be

Range(Cells(12, 2), Cells(19, 12)).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp

I would like to arrange the rows that contain data to make them contiguous and put all the blanks at the bottom. I would rather not delete the row completely because it would mess up some formatting elsewhere is the worksheet.

 

[mikerickson]

Dim inArray as Variant, outArray() as String
Dim i as Long, j as Long, k as Long, m as Long

inArray = Range(Cells(12, 2), Cells(19, 12)).FormulaR1C1

ReDim outArray(1 to UBound(inArray,1), 1 to UBound(inArray, 2))

k = 1: m = 1
For i = 1 to UBound(inArray,1)
    For j = 1 to UBound(inArray, 2)
        If inArray(i, j) <> "" then
            outArray(k, m) = inArray(i, j)
            m = m+1: If UBound(outArray,2) < m Then k = k+1: m=1
        End If
    Next j
Next i

Range(Cells(12, 2), Cells(19, 12)).FormulaR1C1 = outArray

 

[smpatty08]

Dim inArray as Variant, outArray() as String
Dim i as Long, j as Long, k as Long, m as Long

inArray = Range(Cells(12, 2), Cells(19, 12)).FormulaR1C1

ReDim outArray(1 to UBound(inArray,1), 1 to UBound(inArray, 2))

k = 1: m = 1
For i = 1 to UBound(inArray,1)
    For j = 1 to UBound(inArray, 2)
        If inArray(i, j) <> "" then
            outArray(k, m) = inArray(i, j)
            m = m+1: If UBound(outArray,2) < m Then k = k+1: m=1
        End If
    Next j
Next i

Range(Cells(12, 2), Cells(19, 12)).FormulaR1C1 = outArray

After I updated

outArray() as String

To

outArray as Variant

It worked perfectly
This is exactly what I needed! Thank You!