Create an array of rows VBA

Question

New to VBA. I'm trying to create an array of rows.

Basically, I have an entire sheet and want to take all the rows that start with a certain value ("MA") in column 8.

I eventually want to manipulate that array (as if it were a range), and paste it somewhere else in the sheet. Can anyone help? Here's my code so far:

Dim top0M As Variant
ReDim top0M(1 To 1) As Variant

For i = 4 To Rows.Count
    If Cells(i, 8).Value Like "MA*" Then
        top0M(UBound(top0M)) = Rows(i)
        ReDim Preserve top0M(1 To UBound(top0M) + 1) As Variant
    End If
Next i

This code runs but I'm not sure how to debug it to know if I even have the right rows inside. Can I paste these rows as if they were a range?

You are creating an array of arrays, so to save to another sheet you will need to loop and assign each array to the next open row in your target sheet. — Scott Craner
– Scott Craner, Commented Aug 14, 2018 at 18:00
To build an array of ranges you would need Dim top0M As Variant and ReDim top0M(1 To 1) As Variant change to Dim top0M As Range and ReDim top0M(1 To 1) As Range although you really only need one Dim top0M(1 To 1) As Range — Kyle
– Kyle, Commented Aug 14, 2018 at 18:02
is there a row that we can use to limit the scope of column? You are looping the whole sheet 1048576 rows and getting all the columns most which will be blank and we should ignore. — Scott Craner
– Scott Craner, Commented Aug 14, 2018 at 18:02
@Kyle It doesn't work with Range, keeps giving me the 'expected array' elsewhere — Tiberiu
– Tiberiu, Commented Aug 14, 2018 at 18:06
@ScottCraner Thanks, I replaced it with UsedRange.Rows.Count. No wonder it was so slow! — Tiberiu
– Tiberiu, Commented Aug 14, 2018 at 18:07

Scott Craner · Accepted Answer · 2018-08-14 18:35:00Z

2

This sets the range and loads the whole into an array then it loads a different array with the lines that you want:

With ActiveSheet 'This should be changed to the name of the worksheet: Worksheets("MySheet")
    Dim rng As Range
    Set rng = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(4, .Columns.Count).End(xlToLeft).Column))


    Dim tot As Variant
    tot = rng.Value

    Dim top0M As Variant
    ReDim top0M(1 To Application.CountIf(.Range("H:H"), "MA*"), 1 To UBound(tot, 2)) As Variant
    Dim k As Long
    k = 1
    Dim i As Long
    For i = LBound(tot, 1) To UBound(tot, 1)
        If tot(i, 8) Like "MA*" Then
            Dim j As Long
            For j = LBound(tot, 2) To UBound(tot, 2)
                top0M(k, j) = tot(i, j)
            Next j
            k = k + 1
        End If
    Next i
End With

'to print to a sheet just assign the values:

Worksheets("sheet1").Range("A1").Resize(UBound(top0M, 1), UBound(top0M, 2)).Value = top0M

edited Aug 14, 2018 at 18:35

answered Aug 14, 2018 at 18:18

Scott Craner

153k10 gold badges52 silver badges88 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Tiberiu Over a year ago

I get an 'object required' runtime exception at line:

Set rng = .Range(ActiveSheet.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(4, .Columns.Count).End(xlToLeft).Column)).Value

Scott Craner Over a year ago

@Tiberiu I would expect a marked increase in speed over your old code.

YasserKhalil · Accepted Answer · 2018-08-14 19:26:07Z

Try this code

Sub Test()
Dim x           As Variant

x = ActiveSheet.Range("A4").CurrentRegion.Value
x = FilterArray(x, 8, "MA*", True)

ActiveSheet.Range("K14").Resize(UBound(x, 1), UBound(x, 2)).Value = x
End Sub

Function FilterArray(ByVal myRefArr As Variant, ByVal col As Integer, ByVal refValue As String, ByVal equal As Boolean) As Variant
Dim a           As Variant
Dim i           As Long
Dim j           As Long
Dim n           As Long

On Error Resume Next
    n = 1

    If refValue = "" Then
        FilterArray = myRefArr
    Else
        ReDim a(1 To UBound(myRefArr, 1), 1 To UBound(myRefArr, 2))
        For i = 1 To UBound(a, 1)
            If IIf(equal, UCase(myRefArr(i, col)) Like UCase(refValue), Not (UCase(myRefArr(i, col)) Like UCase(refValue))) Then
                For j = 1 To UBound(a, 2)
                    a(n, j) = myRefArr(i, j)
                Next j
                n = n + 1
            End If
        Next i

        a = Application.Transpose(a)
        ReDim Preserve a(1 To UBound(a, 1), 1 To n - 1)
        a = Application.Transpose(a)
        FilterArray = a
    End If
On Error GoTo 0
End Function

Collectives™ on Stack Overflow

Create an array of rows VBA

2 Answers 2

2 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related