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?
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
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