Search through workbook using macro with several ctiterias

Kotler

New Member
Joined
Mar 24, 2011
Messages
1
Hello friends. I’m new member of this forum and I hope that you could help me.
Before describing my issue, I want to admit that I’m not very good at VBA and writing macros, so I do hope that criticism from more experienced member will be avoided. I have done search through internet and could not find macro that would be appropriate for my case.

I’m working with huge file, like 50k-90k records in each sheet, and sometimes sheet number goes up to 10 or even more. My job is to find if these record contain names of certain products: Product1, Product2,…….etc. The min. amount of search terms as a rule is 10 (from Product1 to Product10), but sometimes it goes up to 70.

I’m interesting if it is possible to write a macro that will help me to define if cells in all sheets contains product names(only), if contains copy this name in new workbook. The name of products remain unchanged, but there is a problem with cell value, as sometimes they contain product name in following order: Product1(010170), or like # 22847 Product2, or # Product3 87622. There have been cases where I found these name in texts: There has been 1% decline in sales of Produc1 etc.

Please help me resolve this problem.

Thank you very much
 

Some videos you may like

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

Jing

Active Member
Joined
Feb 11, 2011
Messages
288
This will allow you to search for up to 10 different criteria on any sheet...

press Alt+F11 to access VBA

Insert a new UserForm

the layout can be however you would like... just make sure there is a one ComboBox and 10 text boxes

add two buttons

CommandButton1 & CommandButton2
Search Cancel

Double click on the Userform in any location to access the code and enter the following: (make sure the drop downs on the code sheet are set to UserForm and Initialize)

Code:
Option Explicit
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Dim rng As Range
Dim ctrl As MSForms.Control
Dim Field As String
Field = ComboBox1.ListIndex + 1
'Set Error Handling
On Error GoTo ws_exit:
Application.EnableEvents = False
'Set Range
Set rng = ActiveSheet.UsedRange
For Each ctrl In UserForm1.Controls
    If Left(ctrl.Name, 4) = "Text" Then
       If ctrl.Value <> "" Then
            CreateSheet ctrl.Value
            FilterAndCopy rng, ctrl.Value, Field
            rng.AutoFilter
        End If
     End If
Next
Unload Me
Exit Sub
ws_exit:
    Set rng = Nothing
    Application.EnableEvents = True
    Unload Me
End Sub
Private Sub CommandButton2_Click()
'Cancel Button
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim FillRange       As Range
Dim Cel             As Range
Dim iLastRow        As Long
Dim iLastColumn     As Long
 'Find Last Row
iLastRow = 1
 'Find Last Column
iLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
 'Set Range from A1 to Last Row/Column
Set FillRange = Range("A1", Cells(iLastRow, iLastColumn))
            
For Each Cel In FillRange
    Me.ComboBox1.AddItem Cel.Text
Next
    
ComboBox1.ListIndex = 0
    
Set Cel = Nothing
Set FillRange = Nothing
End Sub

Now Insert a new Module and enter the following Code: (Make sure the drop downs on the code shee are set to General & Formshow)

Code:
Option Explicit
Sub formshow()
'Show Search Form
UserForm1.Show
End Sub
Function FilterAndCopy(rng As Range, Choice As String, Field As String)
    
    Dim FiltRng As Range
    Worksheets(Choice).Cells.ClearContents
    rng.AutoFilter Field:=Field, Criteria1:=Choice
    On Error Resume Next
    Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
    On Error GoTo 0
    FiltRng.Copy Worksheets(Choice).Range("A1")
    Set FiltRng = Nothing
     
End Function
Function CreateSheet(Choice As String)
Dim NewSheet As Worksheet
On Error GoTo Err:
Worksheets(Choice).Select
Exit Function
Err:
Set NewSheet = Worksheets.Add
    On Error Resume Next
    NewSheet.Name = Choice
    On Error GoTo 0
End Function



If you need i can always e-mail you a template to follow...
 

Watch MrExcel Video

Forum statistics

Threads
1,123,481
Messages
5,601,918
Members
414,482
Latest member
morkar

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