Thread: Userform search, amend and delete functions across multiple sheets

Hi there,

I am trying to adapt the DatabaseForm created by Roy Cox to match the requirements
of a database we are currently working on. The main difference between the original
DatabaseForm and the one i'm looking to create is the added ability to add, search,
amend and delete entries across multiple sheets within the same workbook. I would also
like to increase the functionality of the search function by giving the user the option
to add critieria to the search. I have attched the workbook.

I have so far successfully managed to implement the 'add' function across the
multiple sheets in the workbook. I am unsure what to do to the code to make the
'Search', 'Amend' and 'Delete' functions work across the multiple worksheets. The next
step I think is for me to describe what I'm hoping to achieve:

In the attached workbook, you'll see that I have three boxes (1 Textbox & 2 combo
boxes) above the listbox and the command buttons. I would like these three to be the
options available when a user is looking to search. Ideally, I would like the user to
have the ability to choose whether to use all three options or not. If they know the name of
the business, they could just put that in and hit search or they could just choose a status
and the search would return all entries that match the status from all the worksheets
and show these results in the listbox. Regardless of what the user chooses in the top
three boxes when doing a search, I would like the listbox to display information pertaining
to all three choices in the display.

When the user has performed the search and the results have shown up in the listbox, I
would like the user to be able to choose one of the entries in the listbox, this would
then automatically fill out all the relevant used fields in the userform with the information
from the entry. The user can then make changes and hit 'amend' or hit 'delete' to delete
the entry.

Any help with this will be greatly appreciated!

John

any hints or tips here would be greatly appreciated...

here's the code:

Dim MyData     As Range
Dim c          As Range
Dim rFound     As Range
Dim r          As Long
Dim rng        As Range
Const frmMax   As Long = 1000
Const frmHt    As Long = 480
Const frmWidth As Long = 600
Dim sFileName  As String        'image name
Dim oCtrl      As MSForms.Control

Option Explicit

Private Sub RegionDrpDwn_AfterUpdate()
With Me.CityCountyDrpDwn
    Select Case RegionDrpDwn.ListIndex
        Case 0: .List = Sheets("Info").Range("C4:C40").Value
        Case 1: .List = Sheets("Info").Range("D4:D21").Value
        Case 2: .List = Sheets("Info").Range("E4:E17").Value
        Case 3: .List = Sheets("Info").Range("F4:F12").Value
        Case 4: .List = Sheets("Info").Range("G4:G12").Value
    End Select
    End With
End Sub

Private Sub cmbadd_Click()
' set form to workbook
    Dim sht As Worksheet
    Dim NextRw As Long

    Set sht = Sheets(Me.cmdselectblog.Value)
    With sht
        NextRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        

        ' enter data from form to worksheet

        .Cells(NextRw, 1).Value = Me.BusinessNameTxtBox.Value
        .Cells(NextRw, 2).Value = Me.StatusDrpDwn.Value
        .Cells(NextRw, 3).Value = Me.cmdselectblog.Value
        .Cells(NextRw, 4).Value = Me.ContactNameTxtBox.Value
        .Cells(NextRw, 5).Value = Me.JobTitleTxtBox.Value
        .Cells(NextRw, 6).Value = Me.RegionDrpDwn.Value
        .Cells(NextRw, 7).Value = Me.CityCountyDrpDwn.Value
        .Cells(NextRw, 8).Value = Me.ActualLocationTxtBox.Value
        .Cells(NextRw, 9).Value = Me.DirectNumberTxtBox.Value
        .Cells(NextRw, 10).Value = Me.OtherPhoneNumberTxtBox.Value
        .Cells(NextRw, 11).Value = Me.EMailAddressTxtBox.Value
        .Cells(NextRw, 12).Value = Me.WebsiteTxtBox.Value
        .Cells(NextRw, 13).Value = Me.featblogpost.Value
        .Cells(NextRw, 14).Value = Me.featblogpostcost.Value
        .Cells(NextRw, 15).Value = Me.featpostnotes.Value
        .Cells(NextRw, 16).Value = Me.featuredpostareacategory.Value
        .Cells(NextRw, 17).Value = Me.featuredpostcategory1.Value
        .Cells(NextRw, 18).Value = Me.featuredpostcategory2.Value
        .Cells(NextRw, 19).Value = Me.shopwindow.Value
        .Cells(NextRw, 20).Value = Me.shopwindowcost.Value
        .Cells(NextRw, 21).Value = Me.salesnotes1.Value
        .Cells(NextRw, 22).Value = Me.nletter.Value
        .Cells(NextRw, 23).Value = Me.nlettercost.Value
        .Cells(NextRw, 24).Value = Me.salesnotes2.Value
    End With

    'clear the data in form
    With Me
        .BusinessNameTxtBox.Value = ""
        .StatusDrpDwn.Value = ""
        .cmdselectblog.Value = ""
        .ContactNameTxtBox.Value = ""
        .JobTitleTxtBox.Value = ""
        .RegionDrpDwn.Value = ""
        .CityCountyDrpDwn.Value = ""
        .ActualLocationTxtBox.Value = ""
        .DirectNumberTxtBox.Value = ""
        .OtherPhoneNumberTxtBox.Value = ""
        .EMailAddressTxtBox.Value = ""
        .WebsiteTxtBox.Value = ""
        .featblogpost.Value = ""
        .featblogpostcost.Value = ""
        .featpostnotes.Value = ""
        .featuredpostareacategory.Value = ""
        .featuredpostcategory1.Value = ""
        .featuredpostcategory2.Value = ""
        .shopwindow.Value = ""
        .shopwindowcost.Value = ""
        .salesnotes1.Value = ""
        .nletter.Value = ""
        .nlettercost.Value = ""
        .salesnotes2.Value = ""
        End With
End Sub


Private Sub cmbDelete_Click()
    Dim msgResponse As String    'confirm delete
    Application.ScreenUpdating = False
    'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
                         vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse    'action dependent on response
        Case vbYes
            'c has been selected by Find button
            Set c = ActiveCell
            c.EntireRow.Delete    'remove entry by deleting row
            'restore form settings
            With Me
                .cmbAmend.Enabled = False    'prevent accidental use
                .cmbDelete.Enabled = False    'prevent accidental use
                .cmbAdd.Enabled = True    'restore use
                'clear form
                ClearControls
            End With

        Case vbNo
            Exit Sub    'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub

Private Sub cmbFind_Click()
    Dim strFind As String    'what to find
    Dim FirstAddress As String
    Dim rSearch As Range  'range to search
    Set rSearch = Sheet1.Range("a6", Range("a65536").End(xlUp))
    Dim f      As Integer

    strFind = Me.BusinessNameTxtBox.Value    'what to look for

    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .BusinessNameTxtBox.Value = c.Offset(0, 1).Value
                .StatusDrpDwn.Value = c.Offset(0, 2).Value
                .cmdselectblog.Value = c.Offset(0, 3).Value
                .cmbAmend.Enabled = True     'allow amendment or
                .cmbDelete.Enabled = True    'allow record deletion
                .cmbAdd.Enabled = False      'don't want to duplicate record
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1    'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")

                    Case vbOK
                        FindAll
                    Case vbCancel
                        'do nothing
                End Select
                Me.Height = frmMax

            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("A8").AutoFilter

End Sub

Private Sub cmbAmend_Click()
    Application.ScreenUpdating = False
    If rng Is Nothing Then GoTo skip
    For Each c In rng
        If r = 0 Then c.Select
        r = r - 1
    Next c
skip:
    Set c = ActiveCell
    c.Value = Me.BusinessNameTxtBox.Value          ' write amendments to database
    c.Offset(0, 1).Value = Me.StatusDrpDwn.Value
    c.Offset(0, 2).Value = Me.cmdselectblog.Value
    c.Offset(0, 3).Value = Me.ContactNameTxtBox.Value
    'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        ClearControls
        .Height = frmHt
    End With
    If Sheet1.AutoFilterMode Then Sheet1.Range("A8").AutoFilter
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub
Sub FindAll()
    Dim strFind As String    'what to find
    Dim rFilter As Range     'range to search
    Set rFilter = Sheet1.Range("a8", Range("d65536").End(xlUp))
    Set rng = Sheet1.Range("a7", Range("a65536").End(xlUp))
    strFind = Me.BusinessNameTxtBox.Value
    With Sheet1
        If Not .AutoFilterMode Then .Range("A8").AutoFilter
        rFilter.AutoFilter Field:=1, Criteria1:=strFind
        Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
        Me.ListBox1.Clear
        For Each c In rng
            With Me.ListBox1
                .AddItem c.Value
                .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
                .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
                .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
                .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
            End With
        Next c
    End With
End Sub

Private Sub ListBox1_Click()

    If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 1 Then    'User has selected
        r = Me.ListBox1.ListIndex

        With Me
            .BusinessNameTxtBox.Value = ListBox1.List(r, 0)
            .StatusDrpDwn.Value = ListBox1.List(r, 1)
            .cmdselectblog.Value = ListBox1.List(r, 2)
            .cmbAmend.Enabled = True      'allow amendment or
            .cmbDelete.Enabled = True     'allow record deletion
            .cmbAdd.Enabled = False       'don't want duplicate
            If ListBox1.List(r, 4) = "Yes" Then
                .optYes = True
            ElseIf ListBox1.List(r, 4) = "No" Then
                .optNo = True
            End If
        End With
    End If
End Sub


Private Sub UserForm_Initialize()
    Set MyData = Sheet1.Range("a5").CurrentRegion   'database
    With Me
        .Caption = "TWS Blog Leads Management"    'userform caption
        .Height = frmHt
        .Width = frmWidth
    End With
End Sub

Sub ClearControls()
    With Me
        For Each oCtrl In .Controls
            Select Case TypeName(oCtrl)
                Case "TextBox": oCtrl.Value = Empty
                Case "OptionButton": oCtrl.Value = False
            End Select
        Next oCtrl
    End With
End Sub