Find item in Column (input with Textbox) and copy all matches to another sheet.

[Bruno74]

Hello, i am a new user. From Portugal (sorry mistakes).
I have a Userform with a Textbox and a button. Textbox to input the item and search button to find.

I want:
To search for an item in Column "C" of Sheet1 (input on textbox),
It will find more than 5 when i click the search button.
I need to copy those entire rows to Sheet2, all 8 columns to Sheet2 that contains the item.


This is my code. It works for item "1" (only item in order) but when i search for item "2" and so on, it only copies one row to sheet2 but exists more than 5 rows.
Tks for the help.

Private Sub CommandButton1_Click()
 


Dim RowNo As Long, ColNo As Integer, NRow As Long, Sheet1 As Worksheet, Sheet2 As Worksheet


Dim R As Range, vResult As Variant, lRowEnd As Long


Dim Str As String
 


Str = TextBox1


If Str = "" Then Exit Sub


Set Sheet1 = Sheets("Sheet1")


Set Sheet2 = Sheets("Sheet2")


Sheet2.Cells.Clear


 
NRow = 0


 
'** Test if more than 1 entry for requd string **


If WorksheetFunction.CountIf(Sheet1.Columns("C"), Str) > 1 Then


    lRowEnd = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row


    RowNo = 2


    On Error Resume Next


    vResult = "*"


    vResult = WorksheetFunction.Match(Str, Sheet1.Range("C" & RowNo, "C" & lRowEnd), 0)


    Do While IsNumeric(vResult)


        RowNo = RowNo + vResult - 1


        NRow = NRow + 1


       
        Sheet2.Cells(NRow, 1) = Sheet1.Cells(RowNo, 1)


        Sheet2.Cells(NRow, 2) = Sheet1.Cells(RowNo, 2)


        Sheet2.Cells(NRow, 3) = Sheet1.Cells(RowNo, 3)


        Sheet2.Cells(NRow, 4) = Sheet1.Cells(RowNo, 4)


        Sheet2.Cells(NRow, 5) = Sheet1.Cells(RowNo, 5)


        Sheet2.Cells(NRow, 6) = Sheet1.Cells(RowNo, 6)


        Sheet2.Cells(NRow, 7) = Sheet1.Cells(RowNo, 7)


        Sheet2.Cells(NRow, 8) = Sheet1.Cells(RowNo, 8)


       
        RowNo = RowNo + Val(vResult)


        vResult = "*"


        vResult = WorksheetFunction.Match(Str, Sheet1.Range("C" & RowNo, "C" & lRowEnd), 0)


    Loop


    On Error GoTo 0


End If


 
End Sub

 

[Bruno74]

Hello again.
Still trying to finish the project but stuck again...


So, i created a Lisbox1 that populates when i click the search button.
Have a Dynamic range for populating ( Workbook \ Formulas \ Name Manager - =OFFSET(Sheet1!$A$2;0;0;COUNTA(Sheet1!$A:$A)-1;10) )
And this code in the button: ( ListBox1.RowSource = "test" )


It populates with 10 lines. 5 lines the name Mike and 5 lines the name John.
I would like to populate with (in this case) 2 lines. One for Mike and other for John.
I would like do populate only with unique names. Remove the duplicates.


A search and found lots of code for this, but it doesn´t seem to work for me. Am i putting the code in the wrong place? Do i have to change something?


Code i found for removing duplicates:


Sub Sample()
RemovelstDuplicates ctrlListNames
End Sub


Public Sub RemovelstDuplicates(lst As msforms.ListBox)
Dim i As Long, j As Long
With lst
For i = 0 To .ListCount - 1
For j = .ListCount - 1 To (i + 1) Step -1
If .List(j) = .List(i) Then
.RemoveItem j
End If
Next
Next
End With
End Sub

 

[Fluff]

As this is a completely different question, you need to start a new thread

 

[Bruno74]

Hi Fluff

Yes, i will do that.

Tks

 

[ipbr21054]

Old thread read and asking a question please.

Ws2.Cells(Nrow, 1).Resize(, 8).Value = Fnd[COLOR=#ff0000].Offset(, -2)[/COLOR].Resize(, 8).Value

Can you explain please.
Nrow, 1 adds a row at a time ?
8 refers to the columns copied / pasted ?
Offset, 2 ? Please advise.

Thanks.