VBA to provide search data from text box value

[supraman]

Hi All,

i am new to this forum and also new to VBA.

I have a file where some data need to be search using Text box auto filter.

I have 4 text box in my file which will help me to search my data as per criteria, but 2nd Text box is required numeric value for my 1st box search.

I have applied simple auto filter formula for all 3 boxes can any one please help me for my 2nd box which required input in numeric and will show me the data along with the 1st search box value.

example:- in D column i have some data like "java (14), XML (20), Python (5)" in a single line, now i want to search for Java for >=(10) from D column.

Please help me on this I have attached my file here.

[Leith Ross]

Hello supraman,

This was quite a challenge. The code for TextBox2 is below and has been added to the attached workbook.



Private Sub TextBox2_Change()

Dim Cell As Range
Dim Matches As Object
Dim r As Long
Dim RegExp As Object
Dim Rng As Range

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Pattern = TextBox1.Value & "\s+\((\d+)\).*"

Set Rng = Range("A5:F5")

Set Cell = Cells.SpecialCells(xlCellTypeVisible)
r = Cell.Areas(Cell.Areas.Count).Row - 1

If r > Rng.Row Then Set Rng = Rng.Resize(RowSize:=(r - Rng.Row) + 1)

Application.ScreenUpdating = False

For r = Rng.Rows.Count To 1 Step -1
Set Cell = Rng.Cells(r, "D")
Set Matches = RegExp.Execute(Cell.Value)
If Matches.Count Then
If Matches(0).SubMatches(0) <> TextBox2.Value Then
Cell.EntireRow.Hidden = True
Else
Cell.EntireRow.Hidden = False
End If
Else
Cell.EntireRow.Hidden = True
End If
Next r

Application.ScreenUpdating = True


End Sub

[supraman]

Hi Leith,

Thanks for all your hard work over my file, but i found one problem that is the text box 2 is not showing grater than value for given search.
It is only showing the same number, where as my requirement is to found Grater than or equal number for given search.

Appreciate your effort, if you can help me little further will be a great help.

Regards,
Subhankar

[Leith Ross]

Hello supraman,

You are right. I neglected to change the comparison operator to greater than or equal. The needed change is in the code below in bold text.



Private Sub TextBox2_Change()

Dim Cell As Range
Dim Matches As Object
Dim r As Long
Dim RegExp As Object
Dim Rng As Range

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Pattern = TextBox1.Value & "\s+\((\d+)\).*"

Set Rng = Range("A5:F5")

Set Cell = Cells.SpecialCells(xlCellTypeVisible)
r = Cell.Areas(Cell.Areas.Count).Row - 1

If r > Rng.Row Then Set Rng = Rng.Resize(RowSize:=(r - Rng.Row) + 1)

Application.ScreenUpdating = False

For r = Rng.Rows.Count To 1 Step -1
Set Cell = Rng.Cells(r, "D")
Set Matches = RegExp.Execute(Cell.Value)
If Matches.Count Then
If Matches(0).SubMatches(0) >= TextBox2.Value Then
Cell.EntireRow.Hidden = True
Else
Cell.EntireRow.Hidden = False
End If
Else
Cell.EntireRow.Hidden = True
End If
Next r

Application.ScreenUpdating = True


End Sub

[Leith Ross]

Hello supraman,

I was a bit hasty with my reply. I did some more testing, I discovered the fix did not work correctly. Here is the rtested and working correction...



Private Sub TextBox2_Change()

Dim Cell As Range
Dim Matches As Object
Dim r As Long
Dim RegExp As Object
Dim Rng As Range

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Pattern = TextBox1.Value & "\s+\((\d+)\).*"

Set Rng = Range("A5:F5")

Set Cell = Cells.SpecialCells(xlCellTypeVisible)
r = Cell.Areas(Cell.Areas.Count).Row - 1

If r > Rng.Row Then Set Rng = Rng.Resize(RowSize:=(r - Rng.Row) + 1)

Application.ScreenUpdating = False

For r = Rng.Rows.Count To 1 Step -1
Set Cell = Rng.Cells(r, "D")
Set Matches = RegExp.Execute(Cell.Value)
If Matches.Count Then
If Val(Matches(0).SubMatches(0)) <= Val(TextBox2.Value) Then
Cell.EntireRow.Hidden = True
Else
Cell.EntireRow.Hidden = False
End If
Else
Cell.EntireRow.Hidden = True
End If
Next r

Application.ScreenUpdating = True


End Sub

[supraman]

Hello supraman,

I was a bit hasty with my reply. I did some more testing, I discovered the fix did not work correctly. Here is the rtested and working correction...


Leith Hay,

Appreciate your hard work on this it is working fine and provide proper value.

Sorry for the next ask as in my original data the line Items are approx 20k with the same range (Emp ID, Name, Email ID, Skill name, grade, Location)
Now with the script which is for TB2, i can't find the data properly as below:-
1. TB1 search give me all related match with all grade reference if i put a numeric value in TB2 it got stuck for a while may be for the data load.
2. Once value provided in TB3- as 2/3/1- it is not showing the proper search for TB2, and if i had to change the value in TB2 and want to put same reference in TB 3, the data displayed without considering the value from TB3 or TB4.
Ex:- if i want to search Core Java for 10 or More than this for lets say ref 2, first of all it got stuck and after displaying the data if i want to search for a higher (12 or 15) no for similar categories its provide the data as first search. The reference level for column E is not going to consider neither for column E.

is it possible to create some code which can marge TB1 and TB2 value and provide a search result combined, so that if i put "Core java" in TB1 search until i am not giving any numeric value in TB2 it will not work, similarly if i change Tb1 search from "Core java" to some other name for the same value of TB2 or vise versa change in TB2 Value,it need to display the TB1 search with the similar or greater Value of TB2 from D column.

I have provided the original file where one macro is already present which helps to clear previous data and paste new one from another file. if i am going to search, box by box then it shows the correct data with exact format. But in case of any change required on text box 2's value, it will not provide me the data in a proper way, it's not considering the box 3 value. hope now you can understand my need.

Appreciate your hard effort but i am helpless and want your support on this.
My deadline for the task is about to end. if possible can you please short this issue at the earliest.
Or can we connect over a call or sharing the screen so that i can narrate you my need on real time.

Support required badly.
Subhankar
+91-7618788845.
Awaiting for your response.

[supraman]

Hi Leith,

Please help me please

[Leith Ross]

Hello supraman,

What you want to do cannot be done using Excel's built-in filtering methods nor can these methods be changed to do what you want. Basically, you are between a rock and hard place due to your design. VBA would have have to handle all the filtering, which would be much slower than having Excel do it. You need to rethink your design.

[supraman]

Hello supraman,

What you want to do cannot be done using Excel's built-in filtering methods nor can these methods be changed to do what you want. Basically, you are between a rock and hard place due to your design. VBA would have have to handle all the filtering, which would be much slower than having Excel do it. You need to rethink your design.

Hi Leith,

Greetings of the day, Hope you are doing good.

I am a beginner and learning things from you all, it would be very difficult for me to restructure, i have provided you all the details. you know the need also. can you re-structure the macro for me as you want. by this way i also can learn some good stuff.

Hope you won't mind teaching me.

Supraman

[Leith Ross]

Hello supraman,

If you do not need this change immediately, I can work on it over the next few days.

[supraman]

Hello supraman,

If you do not need this change immediately, I can work on it over the next few days.


Absolutely Leith,

Please go ahead i will be waiting for your response.

Thanks for helping me teaching new stuffs.

Subhankar(Supraman)

[Leith Ross]

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

[supraman]

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.


Hi Leith,

Good to see the response time for Box 2. the result is showing similar result where box 2 value need to show equal or grater value for given input, also Leith for the first search Box by Box is giving me perfect result but if i need to change the data for first box only it is not giving me the exact data like:-
BOX by BOX:- 1. Application texting, Box 2:- Grater than or equal to (10), Box3:- 2 for B1 and B2 and Box 4:- any city name, now if i have to change the box 1 value from Application texting to some other one "Java" i am expecting macro to provide result for Java (10) or more than 10 for the same B1 and B2 band, box 4 can be updated by user but the search result goes like there is nothing in Box 2.
Can you please fix if possible or search need to be done by Box to Box way.

One more thing what is the use here for User form, did not get that, can you please explain for my benefit.

Thanks a Ton for your efforts.
You are really helpful.

Thanks
Supraman

[Leith Ross]

Hello Supraman,

After many hours of testing and validating the results, I feel confident that this version will work as desired. The biggest change I made was to entering the skill level in TextBox2. It now requires the user to press Enter once the level is chosen. This is to prevent repeated searching that is not needed.

A Dictionary Object is now used to hold all of the skills and on which rows they can be found. This will loaded up when the file is imported (Get PAR). The macro checks that the dictionary has been loaded. If for some reason it has not then it will be loaded before the search continues.

The search uses both the values of TextBox1 and TextBox2 to make a partial match among all of the skills and their levels. The skill levels are separated and compared to TextBox2. If the skill name (TextBox1) matches any entry in the Dictionary then the skill level must be greater than or equal to what is in TextBox2 for the matching rows to be displayed.

In answer to the question about the UserForm, I was thinking about moving the buttons from Sheet1 on the UserForm to provide for functionality. Just something I was thinking about but decided not to use. I forgot to remove it before posting.

The newest workbook is attached.

[supraman]

Hello Supraman,

After many hours of testing and validating the results, I feel confident that this version will work as desired. The biggest change I made was to entering the skill level in TextBox2. It now requires the user to press Enter once the level is chosen. This is to prevent repeated searching that is not needed.

A Dictionary Object is now used to hold all of the skills and on which rows they can be found. This will loaded up when the file is imported (Get PAR). The macro checks that the dictionary has been loaded. If for some reason it has not then it will be loaded before the search continues.

The search uses both the values of TextBox1 and TextBox2 to make a partial match among all of the skills and their levels. The skill levels are separated and compared to TextBox2. If the skill name (TextBox1) matches any entry in the Dictionary then the skill level must be greater than or equal to what is in TextBox2 for the matching rows to be displayed.

In answer to the question about the UserForm, I was thinking about moving the buttons from Sheet1 on the UserForm to provide for functionality. Just something I was thinking about but decided not to use. I forgot to remove it before posting.

The newest workbook is attached.

Greetings Leith,

Its wonderful to see the macro is working as per criteria, but unfortunately you forgot to mention the box 3 code.

However i am attaching the file which was bit modified by me using some option button. this is absolutely my logic to control the data basis of Option button.
first two option button is for filtering "Virtual" or "Existing" from A column and second set of option button with white shade is for location from column G, just to modified the search for virtual or existing basis along with onsite or offshore. now when i am trying to search the skill from box 1 along with box 2 value, or Box 3 or Box 4 result showing under data sheet is not following the option button filter condition. column A and H showing data as per text box search criteria, however i tried a lot to code like Text box will follow only option button filter.

My code is for the search :- first select "Virtual" or "Existing" second select "Onsite" or "Offshore" and then i will put the value or data in text box and text box will show me the data accordingly. but unfortunately i think module 2 or may be module 3 need to do something which i am not aware of. also when providing value in box 3 it is not giving result as per the box1 and box 2 search.

can you please help on this. i know i am asking so much but i just invented the easiest way to provide the data where no one will be confused.

Please help with attach file

Thanks,
Supraman

[supraman]

Hello Leith,

Please help me on this