Home » excel » excel – Create an array of rows VBA

excel – Create an array of rows VBA

Posted by: admin May 14, 2020 Leave a comment

Questions:

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?

How to&Answers:

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

Answer:

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