Userform search, amend and delete functions across multiple sheets

[john_liquid]

Hi everyone,

I am trying to create a database & userform with the 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 choose between critieria to search on.

I have so far successfully managed to implement the 'add' function across the
multiple sheets in the workbook. However, 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 code below, I would like three boxes to be used with the search function (1 Textbox, 'BusinessNameTxtBox' & 2 combo
boxes, 'StatusDrpDwn' & 'cmdselectblog' respectively). 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 the textbox and hit search or they could just choose a status from the relevant combo box 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

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 cmdselectblog_AfterUpdate()
With Me.featuredpostareacategory
    Select Case cmdselectblog.ListIndex
        Case 0: .RowSource = "Info!I4:I14"
        Case 1: .RowSource = "Info!L4:L8"
        Case 2: .RowSource = "Info!O4:O14"
        Case 3: .RowSource = "Info!R4:R5"
        Case 4: .RowSource = "Info!U4:U5"
    End Select
End With
With Me.featuredpostcategory1
    Select Case cmdselectblog.ListIndex
        Case 0: .RowSource = "Info!J4:J5"
        Case 1: .RowSource = "Info!M4:M9"
        Case 2: .RowSource = "Info!P4:P5"
        Case 3: .RowSource = "Info!S4:S5"
        Case 4: .RowSource = "Info!V4:V5"
    End Select
End With
With Me.featuredpostcategory2
    Select Case cmdselectblog.ListIndex
        Case 0: .RowSource = "Info!K4:K5"
        Case 1: .RowSource = "Info!N4:N9"
        Case 2: .RowSource = "Info!Q4:Q5"
        Case 3: .RowSource = "Info!T4:T5"
        Case 4: .RowSource = "Info!W4:W5"
    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

 

[john_liquid]

Any help would be greatly appreciated!