VBA search 3 partial criteria and display results

dmj120

Board Regular
Joined
Jan 5, 2010
Messages
202
Office Version
  1. 2019
  2. 2010
In an attempt to streamline, I'm wondering if there's a way to add a "search feature" to a sizable workbook.

I'm looking for help with a project (I know VERY little VBA). I'd like to have two tabs: tab 1 the dataset, tab 2 the 'search criteria and results listed.'

Tab 1 has the same three columns as below - just 50k+ rows.

On tab 2, I want to have the ability to enter partial names/numbers into the "search criteria," and then have the results listed in a table below.
A few other points:
1. Not all three search fields will be used each time
2. each field needs to search as a the corresponding cell as a sting omitting spaces, dashes and slashes

The idea is to find a "short list" of possible items (Manf/device/mdl#) that will then be copied onto a different file for consistent nomenclature and further processing. Using the main dataset's filters work to a point, but I'm hoping for something better.

Below are a couple sample representations of what I'm trying to do.

Search Criteria
ManfGE
Device
Mdl #52


ManfDeviceMdl#
3Gen Inc.52 F
AerogenCDL 1521
GE Appliances/Hotpoint56077852
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,968
Office Version
  1. 2007
Platform
  1. Windows
If the data in Tab1 begins in cell A2.
And assuming your data in Tab2 is like this:
varios 04jun2021.xlsm
ABC
1Search Criteria
2Manfge
3Device
4Mdl #52
5
6
7ManfDeviceMdl#
Tab2



Then try this. Results in tab2 starting in cell A8

VBA Code:
Sub Search_criteria()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
  Dim cad1 As String, cad2 As String, cad3 As String
  '
  Set sh1 = Sheets("Tab1")
  Set sh2 = Sheets("Tab2")
  '
  a = sh1.Range("A1:C" & sh1.Range("A:C").Find("*", , xlValues, , 1, 2).Row).Value2
  sh2.Range("A8:C" & Rows.Count).ClearContents
  ReDim b(1 To UBound(a, 1), 1 To 3)
  
  If sh2.[B2] <> "" Then cad1 = "*" & LCase(sh2.[B2].Value) & "*"
  If sh2.[B3] <> "" Then cad2 = "*" & LCase(sh2.[B3].Value) & "*"
  If sh2.[B4] <> "" Then cad3 = "*" & LCase(sh2.[B4].Value) & "*"
  
  For i = 1 To UBound(a, 1)
    If LCase(a(i, 1)) Like cad1 And LCase(a(i, 2)) Like cad2 And LCase(a(i, 3)) Like cad3 Then
      j = j + 1
      b(j, 1) = a(i, 1)
      b(j, 2) = a(i, 2)
      b(j, 3) = a(i, 3)
    End If
  Next i
  
  If j > 0 Then sh2.Range("A8").Resize(j, 3).Value = b
End Sub
 

dmj120

Board Regular
Joined
Jan 5, 2010
Messages
202
Office Version
  1. 2019
  2. 2010
I must be doing something wrong. I saved the file as xlsm, tried running the script (via View > Macros > run), but nothing happens.

Yes, the tab names and starting cell references are correct.

If the data in Tab1 begins in cell A2.
And assuming your data in Tab2 is like this:

Then try this. Results in tab2 starting in cell A8

VBA Code:
Sub Search_criteria()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
  Dim cad1 As String, cad2 As String, cad3 As String
  '
  Set sh1 = Sheets("Tab1")
  Set sh2 = Sheets("Tab2")
  '
  a = sh1.Range("A1:C" & sh1.Range("A:C").Find("*", , xlValues, , 1, 2).Row).Value2
  sh2.Range("A8:C" & Rows.Count).ClearContents
  ReDim b(1 To UBound(a, 1), 1 To 3)
 
  If sh2.[B2] <> "" Then cad1 = "*" & LCase(sh2.[B2].Value) & "*"
  If sh2.[B3] <> "" Then cad2 = "*" & LCase(sh2.[B3].Value) & "*"
  If sh2.[B4] <> "" Then cad3 = "*" & LCase(sh2.[B4].Value) & "*"
 
  For i = 1 To UBound(a, 1)
    If LCase(a(i, 1)) Like cad1 And LCase(a(i, 2)) Like cad2 And LCase(a(i, 3)) Like cad3 Then
      j = j + 1
      b(j, 1) = a(i, 1)
      b(j, 2) = a(i, 2)
      b(j, 3) = a(i, 3)
    End If
  Next i
 
  If j > 0 Then sh2.Range("A8").Resize(j, 3).Value = b
End Sub
 

dmj120

Board Regular
Joined
Jan 5, 2010
Messages
202
Office Version
  1. 2019
  2. 2010

ADVERTISEMENT

I got it - the three search criteria has to have at least one character. Is there a way to not require each search field to require anything?

I must be doing something wrong. I saved the file as xlsm, tried running the script (via View > Macros > run), but nothing happens.

Yes, the tab names and starting cell references are correct.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,968
Office Version
  1. 2007
Platform
  1. Windows
I don't understand, do you want to leave the 3 fields empty?
And what result do you expect?
You can put examples use XL2BB tool.
 

dmj120

Board Regular
Joined
Jan 5, 2010
Messages
202
Office Version
  1. 2019
  2. 2010

ADVERTISEMENT

I'm able to use the * wildcard in one or two of the search fields so the most results are displayed, and this works great!! Because I'm standardizing nomenclature (many variables), I usually start with the mdl#, then "drill down further" with the Manf or device description.

I'm going to try to play around a little and try to add:
1. add boarders to the displayed list
2. automatically un-filter the main list (if it is filtered - I noticed it alters the displayed list)
3. make the "search terms" omit spaces

1623184546331.png


I don't understand, do you want to leave the 3 fields empty?
And what result do you expect?
You can put examples use XL2BB tool.

1623184546331.png
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,968
Office Version
  1. 2007
Platform
  1. Windows
I'm able to use the * wildcard in one or two of the search fields so the most results are displayed, and this works great!!
I'm still lost, what is the problem?
 
Solution

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,968
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,148,145
Messages
5,745,050
Members
423,917
Latest member
Frank1931

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top