'Remove blank entries from an array loaded by a range

I am trying to delete blank entries from an array that was loaded from a field called TY[L3 Name] (1 column, X rows long) from a data table in excel. The below code is intended to remove all blank values from the array (once it has been loaded with the range), and return a new array with rows that only have data in them. I will want to pass this array onto a collection later to remove duplicates, but I am trying to figure out why I can't get ride of the blanks first (now I am at a point where I just want to understand how to do this regardless if i pass this onto something else or not).

The code errors out at the ReDim Preserve line. I first sized the NewArr to the MyArr table, but had blank rows returned at the end. I then tried to resize it so I only had rows with data in them, but I cannot seem to get the NewArr() array to do this without an error.

I am using the immediate window to verify that there are no blank entries (currently 8 rows at the end of the TY[L3 Name] range).

Sub BuildArray()

'   Load array
Dim MyArr()
Dim j As Long

'   Size array
MyArr() = Range("TY[L3 Number]")
ReDim NewArr(LBound(MyArr) To UBound(MyArr), 1)

'   For Loop to search for Blanks and remove from Array
'   The Lbound and UBound parameters will be defined by the size of the TY[L3 Number] field in the TY Table
For i = LBound(MyArr) To UBound(MyArr)
   If MyArr(i, 1) <> "" Then
        j = j + 1
        NewArr(j, 1) = MyArr(i, 1)
   End If
   Next i
ReDim Preserve NewArr(1 To j, 1) 'Error out here; "Subscript out of range." Can't seem to get this Array to new size without blank entries.

'   Debug Window to show results of revised array.
Dim c As Long
For c = LBound(NewArr) To UBound(NewArr)
   Debug.Print NewArr(c, 1)
Next
   Debug.Print "End of List"

End Sub
arraysexcelvbafor-loopsubscript


Solution 1:[1]

Working through arrays can be tricky in VBA, but I think the example below will show you how a different strategy for populating the "No Blanks" Array might be work:

Suppose we start off with a single Worksheet, with the CoolRange named as shown:

start

Generating an array without blanks could be done like this:

Option Explicit
Sub BuildArrayWithoutBlanks()

Dim AryFromRange() As Variant, AryNoBlanks() As Variant
Dim Counter As Long, NoBlankSize As Long

'set references and initialize up-front
ReDim AryNoBlanks(0 To 0)
NoBlankSize = 0

'load the range into array
AryFromRange = ThisWorkbook.Names("CoolRange").RefersToRange

'loop through the array from the range, adding
'to the no-blank array as we go
For Counter = LBound(AryFromRange) To UBound(AryFromRange)
    If AryFromRange(Counter, 1) <> "" Then
        NoBlankSize = NoBlankSize + 1
        AryNoBlanks(UBound(AryNoBlanks)) = AryFromRange(Counter, 1)
        ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) + 1)
    End If
Next Counter

'remove that pesky empty array field at the end
If UBound(AryNoBlanks) > 0 Then
    ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) - 1)
End If

'debug for reference
For Counter = LBound(AryNoBlanks) To UBound(AryNoBlanks)
    Debug.Print (AryNoBlanks(Counter))
Next Counter
Debug.Print "End of List"

End Sub

So, to summarize, we:

  1. Create a 1-D array for our eventual array with blanks removed
  2. Iterate through our original array (with blanks)
  3. Unless the array field is blank, we increase our non-blank counter, then add the value to the non-blank array, then expand the non-blank array
  4. Blow away the last pesky empty field in our non-blank array

From your problem description, it sounds like you'll eventually be stripping away duplicates with a Collection -- love it. Out of curiosity, what will you use the non-blank-but-with-duplicates array for?

Solution 2:[2]

I have worksheet data to remove the lines with "Templates" in them and copy to a second worksheet. Same idea as removing blank lines. I copied the raw data to INArr. I know the width is 16 (Columns) but the length (Rows) is variable. REDIM PRESERVE only works on the last dimension so I transposed the array so it is now 16 rows and unlimited columns while removing the unwanted data. Transpose the array back and copy to the final work sheet.

Hope that makes sense.

'Copy data from Worksheet3 to INArr, Remove "TEMPLATES" and copy to Worksheet2
LR = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
INArr = Sheet3.Range("B6:Q" & LR).Value2
ReDim TempArr(1 To 16, 1 To 1)

x = 0
For i = 1 To UBound(INArr)
    If INArr(i, 14) <> "TEMPLATES" Then
        x = x + 1
        ReDim Preserve TempArr(1 To 16, 1 To x)
        For j = 1 To 16
            TempArr(j, x) = INArr(i, j)
        Next
    End If
Next

ReDim OutArr(1 To x, 1 To 16)
For i = 1 To x
    For j = 1 To 16
        OutArr(i, j) = TempArr(j, i)
    Next
Next
Sheet2.Range("A3:P" & x + 2).Value2 = OutArr

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Community
Solution 2 FrequentFlyer

Related Questions