Find term and paste row help

[luicwadrian]

I was looking at the Multi Filtered Search and Create in the knowledgebas and it seemed to do what i wanted it to until i realized that this only returns result if the entire term in cell is to be entered, word for word.

please help, i want it to return even if my search is contained in the cells.

[GTO]

I was looking at the Multi Filtered Search and Create in the knowledgebas and it seemed to do what i wanted it to until i realized that this only returns result if the entire term in cell is to be entered, word for word.

please help, i want it to return even if my search is contained in the cells.

Greetings :hi:

I see that this is your first post, so let me be the first to welcome you to vbaexpress. I am sure that you will get great help here and hope that you will not mind a suggestion in that light.

Please include which KB entry you read, so we know what it is that was "close, but no cigar."

Mark

[luicwadrian]

Sorry about that, here is the code in that article. It won't let me post a link yet...

'On a Standard Module
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


'In the userform*******************************************************
Option Explicit

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

[luicwadrian]

I have also tried to change the Filter Options to

Criteria1:="=" & CStr(Choice) & "*" ---> which was better but still not quite what I need. Please advise

[luicwadrian]

never mind, figured it out. just had to change Criteria1: = ="=**" & CStr(Choice) & "**"