Hello supraman,
I have had success with updating the code and the speeding up the searching. It is not finished yet but I wanted you to see where I am with functionality.
Here is the code for the UserForm. This is all in the attached workbook.
Option Explicit
Private RegExp As Object
Private Skill_Level As Double
Private Sub TextBox1_Change()
Me.AutoFilterMode = False
Me.Range("D4:F" & Rows.Count).AutoFilter Field:=1, Criteria1:="*" & TextBox1.Value & "*"
End Sub
Private Sub TextBox2_Change()
Dim Cell As Range
Dim Data As Variant
Dim i As Long
Dim LastRow As Long
Dim n As Long
Dim r As Long
Dim RngBeg As Range
Dim Rng As Range
Dim Wks As Worksheet
Dim x As Long
Set Wks = ActiveSheet
Set RngBeg = Wks.Range("A5:F5")
If RegExp Is Nothing Then
Set RegExp = CreateObject("VBScript.RegExp")
End If
' // Search parameters.
RegExp.Global = False
RegExp.IgnoreCase = True
RegExp.Pattern = TextBox1.Value & "[\w\s]+\(" & TextBox2.Value & "\)"
Set Rng = Wks.Cells.SpecialCells(xlCellTypeVisible)
LastRow = Rng.Areas(Rng.Areas.Count).Row
If Rng.Areas.Count = 1 Then
Set Rng = Wks.Range(RngBeg, Wks.Cells(Rows.Count, "A").End(xlUp))
Else
Set Rng = RngBeg.Resize(RowSize:=LastRow - RngBeg.Row + 1)
End If
' // Hide all rows. Rows that have a match will be made visible.
Wks.Range(Wks.Rows(RngBeg.Row), Wks.Rows(LastRow)).Hidden = True
Application.ScreenUpdating = False
' // Copy all the worksheet data in column "D" into a 1 based 2-D array.
Data = Rng.Columns(4).Cells.Value
' // If there is one cell, it will not be assigned to an array.
If VarType(Data) <> vbArray + vbVariant Then
ReDim Data(1, 1)
Data(1, 1) = Rng.Columns(4).Value
End If
' // This is the starting row in column "D".
x = Rng.Row
For i = 1 To UBound(Data, 1)
' // Convert relative reference to worksheet row number.
r = i + RngBeg.Row - 1
' // Check for a match.
If RegExp.Test(Data(i, 1)) Then
If r > x + n Then
Wks.Range(Wks.Rows(x), Wks.Rows(x + n - 1)).Hidden = False
x = r
n = 0
End If
n = n + 1
End If
Next i
' // Check if all rows matched.
If r = x + n Then Wks.Range(Wks.Rows(x), Wks.Rows(x + n - 1)).Hidden = False
Application.ScreenUpdating = True
End Sub
Private Sub TextBox3_Change()
Dim Rng As Range
Dim vaList As Variant
Set Rng = Sheet1.Range("D4:F" & Rows.Count)
Select Case Val(TextBox3)
Case Is = 1: vaList = Array("WISTA", "WIMS", "TEAMRBOW", "SIM")
Case Is = 2: vaList = Array("GROUP B1", "GROUP B2")
Case Is = 3: vaList = Array("GROUP B3", "GROUP C1")
End Select
If VarType(vaList) <> vbEmpty Then
Rng.AutoFilter Field:=2, Criteria1:=vaList, Operator:=xlFilterValues
End If
End Sub
Private Sub TextBox4_Change()
Sheet1.Range("D4:F" & Rows.Count).AutoFilter Field:=3, Criteria1:=TextBox4.Value & "*"
End Sub
Reply With Quote
Originally Posted by Leith Ross
