Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 50178

Userform Search ListBox

$
0
0
Hello...

The attach search userform is working OK.

I just need a little bit changes in it....I just want when user search, the list box should only show "LAST NAMES" .

I allowed List Box to show only 1 column but it is showin "FIRST NAME"..I want that it should only show "LAST NAME"(2nd column) not "First Name.


OR if possible just allow the search box to Search by LAST NAME only and show only last names in the List Box...

All other function in the userform is working fine....no need to change in the remaing userform.

Here is the code..

Code:

Private Sub cmdclose_Click()
Unload Me
End Sub

Private Sub cmddel_Click()
Dim r As Range
Dim msgResponse As String    'confirm delete
 
    Application.ScreenUpdating = False
    'get user confirmation
   
    msgResponse = MsgBox("THIS WILL DELETE THE SELECTED ROW, CONTINUE", _
                        vbCritical + vbYesNo, "DELETE ENTRY")
    Select Case msgResponse    'action dependent on response
    Case vbYes
        'c has been selected by Find button
        Set r = ActiveCell
        r.EntireRow.Delete    'remove entry by deleting row
        'restore form settings
        With Me
            .cmdrep.Enabled = False    'prevent accidental use
            .cmddel.Enabled = False    'prevent accidental use
            .cmdsub.Enabled = True        'restore use
            'clear form
            .txtfn.Value = vbNullString
            .txtln.Value = vbNullString
            .txtloc.Value = vbNullString
            .txtdob.Value = vbNullString
            .txtdoj.Value = vbNullString
            .cbostat.Value = vbNullString
        End With
    Case vbNo
        Exit Sub    'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub

Private Sub cmdrep_Click()
    Dim r  As Long
    Dim C  As Long
    Dim oCtrl  As Control
    C = 1
    r = Me.ListBox1.ListIndex + 4

    For Each oCtrl In Me.Frame1.Controls
        If TypeOf oCtrl Is MSForms.TextBox Or TypeOf oCtrl Is MSForms.ComboBox Then
            Cells(r, C).Value = oCtrl.Value
            C = C + 1
        End If
    Next oCtrl
        With Me
        .txtsearch.Value = ""
        .txtfn.Value = ""
        .txtln.Value = ""
        .txtloc.Value = ""
        .txtdob.Value = ""
        .txtdoj.Value = ""
        .cbostat.Value = ""
        .ListBox1.Clear
        .cmdsub.Enabled = True
        .cmdsearch.Enabled = True
        .cmddel.Enabled = False
        .cmdrep.Enabled = False
    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("First Name", "Last Name")
    res = Me.txtsearch
   
    If Len(res) = 0 Then
Here:
        Application.EnableEvents = False
        With Me.ListBox1
                .ColumnHeads = False
                .RowSource = ""
                .Clear
        End With
        Me.txtsearch.SetFocus
        Me.cmdsearch.Enabled = True
        Me.cmdsub.Enabled = True
        Application.EnableEvents = True
        Exit Sub
    End If
   
    With Me
        .txtfn.Value = ""
        .txtln.Value = ""
        .txtloc.Value = ""
        .txtdob.Value = ""
        .txtdoj.Value = ""
        .cbostat.Value = ""
        .cmdsub.Enabled = False
        .cmdsearch.Enabled = False
        .cmddel.Enabled = True
        .cmdrep.Enabled = True
    End With
   
    With Sheets("Dec07")
        Set r = .Range("DataRange").Find(What:=res, LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
               
        If Not r Is Nothing Then
            ReDim a(1 To 6, 1 To 1): i = 1
            faddress = r.Address: ReDim Preserve a(1 To 6, 1 To i)
            For ii = 1 To 6
              a(ii, i) = .Cells(r.Row, ii).Value
            Next
            Do
                Set r = .Range("DataRange").FindNext(r)
                If r.Address = faddress Then Exit Do
                i = i + 1: ReDim Preserve a(1 To 6, 1 To i)
                For ii = 1 To 6
                        a(ii, i) = .Cells(r.Row, ii).Value
                Next
            Loop Until r Is Nothing
        Else
            MsgBox "DATA DOES NOT EXIST", vbInformation + vbOKOnly, "DATA NOT FOUND"
            Me.txtsearch = ""
            GoTo Here
        End If
    End With
    noclick = True
    With Me.ListBox1
        .ColumnCount = 1
        .ColumnWidths = "100"
        If i > 2 Then
            .List = Application.Transpose(a)
        Else
            .Column = a
        End If
    End With
    noclick = False
End Sub

Private Sub cmdsub_Click()
Dim iRow As String
Dim ws As Worksheet

Set ws = Worksheets("Dec07")

  iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row

  ws.Cells(iRow, 1).Value = Me.txtfn.Value
  ws.Cells(iRow, 2).Value = Me.txtln.Value
  ws.Cells(iRow, 3).Value = Me.txtloc.Value
  ws.Cells(iRow, 4).Value = Me.txtdob.Value
  ws.Cells(iRow, 5).Value = Me.txtdoj.Value
  ws.Cells(iRow, 6).Value = Me.cbostat.Value
    With Me
        .txtsearch.Value = ""
        .txtfn.Value = ""
        .txtln.Value = ""
        .txtloc.Value = ""
        .txtdob.Value = ""
        .txtdoj.Value = ""
        .ListBox1.Clear
    End With
End Sub

Private Sub ListBox1_Click()
If noclick = True Then Exit Sub
    With Me
        .txtfn = ListBox1.Column(0)
        .txtln = ListBox1.Column(1)
        .txtloc = ListBox1.Column(2)
        .txtdob = ListBox1.Column(3)
        .txtdoj = ListBox1.Column(4)

    End With
End Sub

Private Sub txtSearch_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.txtsearch
        .Text = .Text & "*"
    End With
    cmdsearch_Click
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, _
  CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then
    Cancel = True
    MsgBox "PLEASE USE THE CLOSE BUTTON!"
  End If
End Sub

Thank you
Attached Files

Viewing all articles
Browse latest Browse all 50178

Trending Articles