Hi all,

I'm trying to make a find/edit/delete/new userform.
I'm nearly there witht he search part but there's one problem.

I need to stop it from bringing up identical entries for example if I enter * because I want to see all entries it brings each entry 14 tmies. Or if I enter the search term 50 referring to the rate, it brings up 12 entries when it should only be 11 because one of them it doubles as it has the digits 50 in another column.

Here's the code:

Code:
Public noclick As Boolean   'For Search refresh

Private Sub Listbox1_Click()
    If noclick = True Then Exit Sub
    With Me
        .txtWBS.Value = Listbox1.Column(2)
        .txtTotal.Value = Listbox1.Column(3)
        .txtDoj.Value = Listbox1.Column(4)
        .txtAT.Value = Listbox1.Column(5)
        .txtRate.Value = Listbox1.Column(6)
        .txtSC.Value = Listbox1.Column(7)
        .txtJobdesc.Value = Listbox1.Column(8)
        .txtAct.Value = Listbox1.Column(9)
        .txtWk.Value = Listbox1.Column(10)
        .txtPN.Value = Listbox1.Column(11)
        .txtFac.Value = Listbox1.Column(12)
        .txtBT.Value = Listbox1.Column(13)
        .txtPC.Value = Listbox1.Column(14)
        .txtStock.Value = Listbox1.Column(15)
        .txtMC.Value = Listbox1.Column(16)
        
    End With
End Sub
Private Sub cmdSearch_Click()

Dim a(), r As Range, res, i As Long, ff As String, rng As Range
Dim title
    
    title = Array("WBS", "Date of booking", "Activity", "Programme Name", "Facility", "Resource Code")
    res = Me.txtSearch
    
    If Len(res) = 0 Then
Here:
        Application.EnableEvents = False
        With Me.Listbox1
                .ColumnHeads = False
                .RowSource = ""
                .Clear
        End With
        Me.txtSearch.SetFocus
        Application.EnableEvents = True
        Exit Sub
    End If
    
    With Me
        .txtPN.Value = Null
        .txtPC.Value = Null
        .txtDoj.Value = Null
        .txtWk.Value = Null
        .txtAct.Value = Null
        .txtFac.Value = Null
        .txtWBS.Value = Null
        .txtJobdesc.Value = Null
        .txtMC.Value = Null
        .txtTC.Value = Null
        .txtBT.Value = Null
        .txtAT.Value = Null
        .txtStock.Value = Null
        .txtSC.Value = Null
        .txtRate.Value = Null
        .txtTotal.Value = Null
    End With
    
    With Sheets("DATABASE")
        Set r = .Range("ProductRange").Find(What:=res, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
        If Not r Is Nothing Then
            ReDim a(1 To 17, 1 To 1): i = 1
            faddress = r.Address: ReDim Preserve a(1 To 17, 1 To i)
            For ii = 1 To 17
                If ii = 2 Then
                    a(ii, i) = Format(.Cells(r.Row, ii), "000-000-00")
                Else
                    a(ii, i) = .Cells(r.Row, ii).Value
                End If
            Next
            Do
                Set r = .Range("ProductRange").FindNext(r)
                If r.Address = faddress Then Exit Do
                i = i + 1: ReDim Preserve a(1 To 17, 1 To i)
                For ii = 1 To 17
                    If ii = 2 Then
                        a(ii, i) = Format(.Cells(r.Row, ii), "000-000-00")
                    Else
                        a(ii, i) = .Cells(r.Row, ii).Value
                    End If
                Next
            Loop Until r Is Nothing
        Else
            MsgBox "This Product Has Not Been Found, Please Try Again", vbInformation + vbOKOnly, "Product Not Found"
            Me.txtSearch = ""
            GoTo Here
        End If
    End With
    noclick = True
    With Me.Listbox1
        .ColumnCount = 17
        .ColumnWidths = "40;40;40;40;40;40;40;40;40;40;40;40;40;40;40;40;40"
        If i > 1 Then
            .List = Application.Transpose(a)
        Else
            .Column = a
        End If
    End With
    noclick = False
End Sub
Many thanks,
Z