Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
Dim tmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
tmpArr = sArray
ColIndex = ColIndex + LBound(tmpArr, 2) - 1
Chk = (InStr("><=", Left(FindStr, 1)) > 0)
For i = LBound(tmpArr, 1) - HasTitle To UBound(tmpArr, 1)
If Chk Then
TmpVal = CDbl(tmpArr(i, ColIndex))
If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
Else
If InStr(UCase(tmpArr(i, ColIndex)), UCase(FindStr)) Then Dic.Add i, ""
End If
Next
If Dic.Count > 0 Then
Tmp = Dic.Keys
ReDim Arr(LBound(tmpArr, 1) To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle, LBound(tmpArr, 2) To UBound(tmpArr, 2))
For i = LBound(tmpArr, 1) - HasTitle To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle
For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
Arr(i, j) = tmpArr(Tmp(i - LBound(tmpArr, 1) + HasTitle), j)
Next
Next
If HasTitle Then
For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
Arr(LBound(tmpArr, 1), j) = tmpArr(LBound(tmpArr, 1), j)
Next
End If
End If
Filter2DArray = Arr
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment