Slow search/filter algorithm - excel

Question

My problem is, my current code is pretty slow right now and i would like to make it faster, but don't know how.
I have data sets in rows, which looks like this:
I need to filter/search those values like numbers (for example show all >30). But some of the entries, like 30|32,89 are not numbers. Right now i am checking each value, if it needs to be split, like 30|32,89 in 30 and 32,89 and write all the values in a sheet. So i have a column, where all the values are numbers. With a second column, which saves the original row number, Like this:
After that i use advanced filter to get the data i need. I write it in another column. Using original row numbers to write values from the same original cell only ones, if several of the numbers in that cell meet the search criteria. And to do this, i save all the original data(20 columns and many rows) in a 2D array. Then i take only the values from that array, where the 1st index matches the original row number of the filtered data and write all of the values one buy one in another sheet in a row for each 1st index (this part causes the majority of the slowness). There are 20 values for each 1st index. So at the end i get all the corresponding data for the filtered items shown in one table.
Here is my code for that:
Public Sub numberSearch(srchCol As String, srchValue As String)
Dim sValues As Variant, wRange As Variant
'temp values
cRow = archSh.Range("A1").CurrentRegion.rowS.count
Dim srchCol As String
srchCol = "B"
Dim srchValue As String
srchValue = ">2005"
'------------------
'prepare sheet
shSearch.Cells.Clear
sValues = Application.Transpose(archSh.Range(srchCol & "2", srchCol & cRow))
wRange = archSh.Range("A1").CurrentRegion
shSearch.Range("A1").Value = archSh.Range(srchCol & "1").Value
shSearch.Range("B1").Value = "tst"
shSearch.Range("D1").Value = shSearch.Range("A1").Value
shSearch.Range("E1").Value = shSearch.Range("B1").Value
shSearch.Range("G1").Value = shSearch.Range("A1").Value
shSearch.Range("H1").Value = shSearch.Range("B1").Value
shSearch.Range("D2").Value = srchValue
'----------------------------
'spilt values, make all numeric
Dim i As Long, j As Long, k As Long
Dim tst As Variant, c As Variant
Dim s
i = 2
k = 2
For Each c In sValues
If IsNumeric(c) = True Then
ReDim tst(0 To 0)
tst(0) = c
Else
tst = Split(c, sepa)
End If
For j = 0 To UBound(tst)
shSearch.Range("A" & k + j).Value = tst(j)
shSearch.Range("B" & k + j).Value = i
Next j
i = i + 1
k = k + UBound(tst) - LBound(tst) + 1
Next
'--------------------------------
'filter data
Dim rgData As Range, rgCrit As Range, rgOut As Range
Set rgData = shSearch.Range("A1").CurrentRegion
Set rgCrit = shSearch.Range("D1").CurrentRegion
Set rgOut = shSearch.Range("G1").CurrentRegion
rgData.AdvancedFilter xlFilterCopy, rgCrit, rgOut
'---------------------------------
'write searched data
Dim searchColVal As Variant
searchColVal = Application.Transpose(shSearch.Range("H1:H" & shSearch.Cells(rowS.count, 8).End(xlUp).row))
Dim tempItem As Long
tempItem = 0
k = 4
tmpSh.Range("A4").CurrentRegion.Clear
archSh.Range("A1:T1").Copy tmpSh.Range("A4")
For i = 2 To UBound(searchColVal)
If tempItem <> searchColVal(i) Then
ReDim Preserve filterRow(1 To k - 3)
filterRow(k - 3) = searchColVal(i)
k = k + 1
tempItem = searchColVal(i)
For j = 1 To UBound(wRange, 2)
tmpSh.Cells(k, j).Value = wRange(searchColVal(i), j)
Next j
End If
Next i
'----------------------------------------
End Sub
Can anybody help me with speeding up this mess please? Ty in advance.

Answer 1

You can do this with the Advanced Filter and formula criteria.
We use FILTERXML (available in Excel 2013+) to split the text values.
We also is the ISNUMBER function to exclude the text values from being cast as TRUE by the comparison in the first formula.
And the Advanced Filter has an option to write the results elsewhere
For your example, the two formulas might be:
=AND(ISNUMBER(A9),A9>30)
=OR(FILTERXML("<t><s>" & SUBSTITUTE(A9,"|","</s><s>") & "</s></t>","//s")>30)
Before Filter
After Filter
Or, if you change the criteria in both formulas for >30 to <30
Depending on what you need, you could certainly use VBA to generate the relevant formulas.

Answer 2

This scans down the column, splits the cell value into an array then uses Evaluate to apply the search value.
Public Sub numberSearch2()
Const COL_FILTER = "B"
Const srchValue = ">2005"
Dim wb As Workbook, wsSource As Worksheet, WsTarget, t0 As Single
Dim iRow As Long, iLastRow As Long, iTargetRow As Long
Dim ar As Variant, i As Integer
t0 = timer
Set wb = ThisWorkbook
Set wsSource = wb.Sheets("Sheet2")
Set WsTarget = wb.Sheets("Sheet3")
WsTarget.Cells.Clear
wsSource.Rows(1).EntireRow.Copy WsTarget.Range("A1")
iTargetRow = 2
With wsSource
iLastRow = .Range(COL_FILTER & Rows.Count).End(xlUp).Row
For iRow = 2 To iLastRow
ar = Split(.Cells(iRow, COL_FILTER), "|")
For i = 0 To UBound(ar)
If Evaluate(ar(i) & srchValue) Then
wsSource.Rows(iRow).EntireRow.Copy WsTarget.Cells(iTargetRow, 1)
iTargetRow = iTargetRow + 1
i = UBound(ar) ' exit loop
End If
Next
Next
End With
MsgBox iLastRow - 1 & " rows read " & vbCr & _
iTargetRow - 2 & " rows written", vbInformation, "Completed in " & Int(timer - t0) & " secs"
End Sub