Filter an array

[Hege M]

Hey!

I have a multidimensional array and I wan't to filter this array into an
other variable.
The array is something like A(Projectnr, SampleNr, Info) and I would like to
be able to show just those records that have projectnr = B.

Is there an easy way to do this?

Hope someone can help me.
Thanks.

Hege

 

[Doug Robbins - Word MVP]

Something like this:

Dim myarray As Variant
Dim newarray As Variant
ReDim myarray(4, 2)
Dim i As Long, j As Long, k As Long
For i = 0 To 2
myarray(i, 0) = "A"
For j = 1 To 2
myarray(i, j) = "Item" & Format(i) & Format(j)
Next j
Next i
For i = 3 To 4
myarray(i, 0) = "B"
For j = 1 To 2
myarray(i, j) = "Item" & Format(i) & Format(j)
Next j
Next i
k = 0
For i = 0 To 4
If myarray(i, 0) = "B" Then
k = k + 1
End If
Next i
ReDim newarray(k - 1, 2)
k = 0
For i = 0 To 4
If myarray(i, 0) = "B" Then
For j = 0 To 2
newarray(k, j) = myarray(i, j)
Next j
k = k + 1
End If
Next i
For i = 0 To 4
For j = 0 To 2
MsgBox "myarray - " & myarray(i, j)
Next j
Next i
For i = 0 To k - 1
For j = 0 To 2
MsgBox "newarray - " & newarray(i, j)
Next j
Next i

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[RB Smissaert]

This code may do what you want:

Sub FilterArray(ByRef arrToFilter As Variant, _
ByRef arrFilterValues As Variant, _
ByRef lCol As Long)

'will take one 2-D array and pass the rows that have a value
'that is in another 1-D array
'arrToFilter is the array to filter
'arrFilterValues is the array with the filter values
'lCol is the column in the array to filter where to look for the values
'----------------------------------------------------------------------

Dim LB1arrToFilter As Byte
Dim UB1arrToFilter As Long
Dim UB2arrToFilter As Long
Dim LBarrFilterValues As Byte
Dim UBarrFilterValues As Long
Dim i As Long
Dim n As Long
Dim c As Long
Dim lCounter As Long
Dim arr3
Dim arr4

LB1arrToFilter = LBound(arrToFilter)
UB1arrToFilter = UBound(arrToFilter)
UB2arrToFilter = UBound(arrToFilter, 2)
LBarrFilterValues = LBound(arrFilterValues)
UBarrFilterValues = UBound(arrFilterValues)
lCounter = LB1arrToFilter

'setup an array the same size as the original array to filter
'------------------------------------------------------------
ReDim arr3(LB1arrToFilter To UB1arrToFilter, LB1arrToFilter To
UB2arrToFilter)

'copy the rows when a value is found
'-----------------------------------
For i = LB1arrToFilter To UB1arrToFilter
For n = LBound(arrFilterValues) To UBound(arrFilterValues)
If arrToFilter(i, lCol) = arrFilterValues(n) Then
For c = LB1arrToFilter To UB2arrToFilter
arr3(lCounter, c) = arrToFilter(i, c)
Next
lCounter = lCounter + 1
End If
Next
Next

'exit if no matching values
'--------------------------
If lCounter = 0 Then
ReDim arr4(LB1arrToFilter To LB1arrToFilter, _
LB1arrToFilter To LB1arrToFilter)
arr4(LB1arrToFilter, LB1arrToFilter) = "nil found"
arrToFilter = arr4
Exit Sub
End If

'size the final array
'--------------------
ReDim arr4(LB1arrToFilter To lCounter - 1, _
LB1arrToFilter To UB2arrToFilter)

'fill the final array
'--------------------
For i = LB1arrToFilter To lCounter - 1
For c = LB1arrToFilter To UB2arrToFilter
arr4(i, c) = arr3(i, c)
Next
Next

arrToFilter = arr4

End Sub


If speed is important then you could put this in a VB6 ActiveX dll and
compile with
all the fast compile options.


RBS