Filter 2d array in memory using loops

[Dharmesh Patel]

Hi,
Is it possible to filter a 2d array in memory.
I have a 2 dimensional Array (7 columns by 300 rows) I want to assign it to Listbox but I need it filtered on a user defined variable on column 5.

I can do most apart from filter in memory and return results to work sheet.
Is it possible? it would be even better if we can do filter in multiple columns.

Many Thanks
Kind Regards
Dharmesh

 

[Dharmesh Patel]

Thanks to Domanic
here is my solution, I am sure you can make it neater and pass all in one go rather re running it for a new filter each time.

 Sub test()
 
    Dim ArrMyNew2DArray() As Variant
    Dim Arr As Variant
     Dim Arr2 As Variant
    Dim Cnt As Long
    Dim i As Long
    Dim j As Long
    Dim ArrMy2DArray() As Variant
    Dim WS As Variant
    Dim Avalib As Variant
    Dim ArrMy2NDNew2DArray() As Variant
 
    ArrMy2DArray = Worksheets("Sheet1").Range("a1:g75").Value
 
    Avalib = Sheets("Sheet2").Range("B1")
    WS = Sheets("Sheet2").Range("A1")
    Arr = Array(WS)
 
    For i = LBound(ArrMy2DArray, 1) To UBound(ArrMy2DArray, 1)
 
 
        MatchVal = Application.Match(ArrMy2DArray(i, 1), Arr, 0)
 
 
 
        If Not IsError(MatchVal) Then
            Cnt = Cnt + 1
            ReDim Preserve ArrMyNew2DArray(1 To UBound(ArrMy2DArray, 2), 1 To Cnt)
            For j = LBound(ArrMy2DArray, 2) To UBound(ArrMy2DArray, 2)
                ArrMyNew2DArray(j, Cnt) = ArrMy2DArray(i, j)
            Next j
        End If
    Next i
 
    Worksheets("Sheet3").Range("A1").Resize(UBound(ArrMyNew2DArray, 2), UBound(ArrMyNew2DArray, 1)) = WorksheetFunction.Transpose(ArrMyNew2DArray)
ArrMyNew2DArray = Application.Transpose(ArrMyNew2DArray)
 
    i = 0
    j = 0
    Cnt = 0
     Arr2 = Array(Format(Avalib, "mmm-yy"))
    For i = LBound(ArrMyNew2DArray, 1) To UBound(ArrMyNew2DArray, 1)
        MatchVal = Application.Match(ArrMyNew2DArray(i, 7), Arr2, 0)
        If Not IsError(MatchVal) Then
            Cnt = Cnt + 1
            ReDim Preserve ArrMy2NDNew2DArray(1 To UBound(ArrMyNew2DArray, 2), 1 To Cnt)
            For j = LBound(ArrMyNew2DArray, 2) To UBound(ArrMyNew2DArray, 2)
                ArrMy2NDNew2DArray(j, Cnt) = ArrMyNew2DArray(i, j)
            Next j
        End If
    Next i
  Worksheets("Sheet4").Range("A1").Resize(UBound(ArrMy2NDNew2DArray, 2), UBound(ArrMy2NDNew2DArray, 1)) = WorksheetFunction.Transpose(ArrMy2NDNew2DArray)
End Sub

 

[ZVI]

Hi Dharmesh,
Put this code into userform's module and try:

' Code of UserForm1 with ListBox1
Private Sub UserForm_Initialize()
  
  ' --> Settings, change the filter criteria to suit
  Const FilterCol5 = 1
  Const FilterCol6 = "Ok"
  ' <-- End of Settings
  
  Dim a, i&, r&, c&, cs&
  a = Worksheets("Sheet1").Range("a1:g75").Value
  cs = UBound(a, 2)
  ListBox1.ColumnCount = cs
  i = -1
  For r = 1 To UBound(a)
    If a(r, 5) = FilterCol5 And a(r, 6) = FilterCol6 Then ' <-- filter criteria
      i = i + 1
      With ListBox1
        .AddItem a(r, 1)
        For c = 1 To cs
          .List(i, c) = a(r, c)
        Next
      End With
    End If
  Next
End Sub

Regards,

 

[Dharmesh Patel]

Thanks ZVI,
I have changed the constants to a integer and a Date variable and it works well.

' Code of UserForm1 with ListBox1
Private Sub UserForm_Initialize()
 
  ' --> Settings, change the filter criteria to suit
 FilterCol5 = Sheets("sheet2").Range("a1").Value
  FilterCol6 = Sheets("sheet2").Range("b1").Value
 
  ' <-- End of Settings
 
  Dim a, i&, r&, c&, cs&
  a = Worksheets("Sheet1").Range("a1:g75").Value
  cs = UBound(a, 2)
  ListBox1.ColumnCount = cs + 1
  i = -1
  For r = 1 To UBound(a)
    If  a(r, 5)= FilterCol5 And a(r, 7) <= FilterCol6 Then ' <-- filter criteria
      i = i + 1
      With ListBox1
        .AddItem a(r, 1)
        For c = 1 To cs
          .List(i, c) = a(r, c)
        Next
      End With
    End If
  Next
End Sub

Do I put a If startement and a statement like 1=1 if we want to show all values if a filter variable is blank? So if a FilterCol5 is "blank" then set FilterCol5 = a(r, 5).

 

[ZVI]

Do I put a If startement and a statement like 1=1 if we want to show all values if a filter variable is blank? So if a FilterCol5 is "blank" then set FilterCol5 = a(r, 5).

Sure, try:

' Code of UserForm1 with ListBox1
Private Sub UserForm_Initialize()
 
  ' --> Settings, change the filter criteria to suit
  FilterCol5 = Sheets("sheet2").Range("a1").Value
  FilterCol7 = Sheets("sheet2").Range("b1").Value
 
  ' <-- End of Settings
 
  Dim a, i&, r&, c&, cs&
  a = Worksheets("Sheet1").Range("a1:g75").Value
  cs = UBound(a, 2)
  ListBox1.ColumnCount = cs + 1
  i = -1
  For r = 1 To UBound(a)
    If a(r, 5) = FilterCol5 And a(r, 7) <= FilterCol7 Or FilterCol5 = "" Then ' <-- filter criteria
      i = i + 1
      With ListBox1
        .AddItem a(r, 1)
        For c = 1 To cs
          .List(i, c) = a(r, c)
        Next
      End With
    End If
  Next
End Sub

Empty cell in Sheets("sheet2").Range("a1") disables filtering to show all data in ListBox.

 

[ZVI]

To skip filtering of 5th column, and filter only by 7th column, this modification works:

    If (a(r, 5) = FilterCol5 Or FilterCol5 = "") And a(r, 7) <= FilterCol7 Then ' <-- filter criteria