Excel VBA Userform to search multiple worksheets

[ExcelEndeavor]

First, some context...

I have a userform that users complete to capture the salesperson, product ID, product category, revenue amount, and sales date. There is a submit button that funnels the data into 1 of 5 seperate worksheets that are based on product category selected in the userform:

Industrial, consturction, maintenance, hospitality, administrative

(All of the worksheets are formatted exactly the same with the salesperson in column C - it's just to keep the categories separate)

*** This part works great ***



Now, I want to create a userform to search for the salesperson across all 5 worksheets and display the results into a listbox. Then, I can double-click one of the results to open the original userform that was completed for the details of that item and/or make edits if needed. Again, the worksheets are all formatted exactly the same, with the Salesperson in column C.

How would I accomplish this?

 

[DanteAmor]

I changed it based on this worksheet - this is a budgeting sheet, which is different from the sales sheet that I was originally working on.

I deleted all your code because it didn't work.

I put in my code and just made a few small changes to suit your needs.

Private Sub UserForm_Activate()
  Dim a As Variant
  Dim sh As Worksheet
  Dim arr As Variant, itm As Variant
  Dim i As Long, j As Long, k As Long
 
  arr = Array("Enterprise", "MI", "Title", "Real Estate", "Conduit", "Corp Comm", "Events")
  
  k = 0
  For Each itm In arr
    Set sh = Sheets(itm)
    a = sh.Range("A17:G" & sh.Range("C" & Rows.Count).End(3).Row).Value
  
    With lbxResults
      .ColumnCount = UBound(a, 2) + 2
      .ColumnWidths = "150;0;150;0;0;80;20"
      For i = 1 To UBound(a, 1)
        .AddItem
        For j = 1 To UBound(a, 2)
          .List(k, j - 1) = a(i, j)
        Next
        .List(k, 5) = sh.Name
        .List(k, 6) = i + 1
        k = k + 1
      Next
    End With
  Next
End Sub

Now it works:

I return the file to you, with the progress to show all the data of all the sheets in the listbox.

Budget - TEST v3 dam.xlsm

drive.google.com

NOTE: To create the code for the "Search" button I need more time. Give me a chance to create it and I'll deliver it to you later.

 

[ExcelEndeavor]

I deleted all your code because it didn't work.

I put in my code and just made a few small changes to suit your needs.

Private Sub UserForm_Activate()
  Dim a As Variant
  Dim sh As Worksheet
  Dim arr As Variant, itm As Variant
  Dim i As Long, j As Long, k As Long
 
  arr = Array("Enterprise", "MI", "Title", "Real Estate", "Conduit", "Corp Comm", "Events")
 
  k = 0
  For Each itm In arr
    Set sh = Sheets(itm)
    a = sh.Range("A17:G" & sh.Range("C" & Rows.Count).End(3).Row).Value
 
    With lbxResults
      .ColumnCount = UBound(a, 2) + 2
      .ColumnWidths = "150;0;150;0;0;80;20"
      For i = 1 To UBound(a, 1)
        .AddItem
        For j = 1 To UBound(a, 2)
          .List(k, j - 1) = a(i, j)
        Next
        .List(k, 5) = sh.Name
        .List(k, 6) = i + 1
        k = k + 1
      Next
    End With
  Next
End Sub

Now it works:

View attachment 121608​

I return the file to you, with the progress to show all the data of all the sheets in the listbox.

Budget - TEST v3 dam.xlsm

drive.google.com

NOTE: To create the code for the "Search" button I need more time. Give me a chance to create it and I'll deliver it to you later.

Thank you for doing that! Would it also be possible to double click on one of the results and have it open the original form ("RequestForm") that it was created with to edit the details?

 

[DanteAmor]

Would it also be possible to double click on one of the results and have it open the original form ("RequestForm") that it was created with to edit the details?

Of course, I'm working on it

 

[DanteAmor]

Hi @ExcelEndeavor, Review all changes.

For 2 userforms to work, several changes are necessary in the 2 userforms.

The main form is going to be RequestForm

I added the "Open Form to Search" button to open the "OpenExistingForm" form, perform the search, select the record to edit, modify. Press "Submit" and modify the selected record.
I also added a Label at the end of the form to know if you are editing a record.

The "Add new records" functionality will work as normal.

Code for userform: RequestForm

Option Explicit

    Public updateRow As Long

Private Sub ButtonCancel_Click()

    Unload Me

End Sub


Private Sub ComboBU_Change()

End Sub

Private Sub ComboCategory_Change()

    Select Case ComboCategory.Value
        Case Is = "Advertising"
            ComboSubcategory.RowSource = "Advertising"
        Case Is = "Public Relations"
            ComboSubcategory.RowSource = "Public_Relations"
        Case Is = "Software Expense"
            ComboSubcategory.RowSource = "Software_Expense"
        Case Is = "Outside Services"
            ComboSubcategory.RowSource = "Outside_Services"

End Select

End Sub


Private Sub ComboSubcategory_Change()
  
  If Me.ComboSubcategory.Value <> "" Then
    Me.TxtExpenseAcct.Value = Application.WorksheetFunction.VLookup(Me.ComboSubcategory.Value, Sheet9.Range("A:B"), 2, 0)
  End If
End Sub

Private Sub CommandButton1_Click()
  OpenExistingForm.Show
End Sub

Private Sub SubmitButton_Click()

    'Message Boxes for Required Fields
    If TxtTeamLead.Value = "" Then
        MsgBox "Please Enter the Team Lead Name", vbCritical
        Exit Sub
    End If
    
    If ComboCategory.Value = "" Then
        MsgBox "Please Select a Category", vbCritical
        Exit Sub
    End If
    
    If ComboSubcategory.Value = "" Then
        MsgBox "Please Select a Subcategory", vbCritical
        Exit Sub
    End If

    If TxtPayee.Value = "" Then
        MsgBox "Please Enter a Payee or Vendor", vbCritical
        Exit Sub
    End If

    If TxtDescription.Value = "" Then
        MsgBox "Please Provide a Description of the Project", vbCritical
        Exit Sub
    End If
    
    If TxtBudget.Value = "" Then
        MsgBox "Please Enter a Budget for the Project", vbCritical
        Exit Sub
    End If

    'Create variable for each detail - Requestor Information
    Dim TeamLead As String
    Dim BusinessUnit As String
    Dim Category As String
    Dim Subcategory As String
    
    'Create variable for each detail - Project Details
    Dim Payee As String
    Dim Description As String
    Dim Budget As String
    
    'Create variable for each detail - PO/Invoice Details
    Dim PONumber As String
    Dim Invoice1Nbr As String
    Dim Invoice1Date As String
    Dim Invoice1Amnt As String
    Dim Invoice2Nbr As String
    Dim Invoice2Date As String
    Dim Invoice2Amnt As String
    Dim Invoice3Nbr As String
    Dim Invoice3Date As String
    Dim Invoice3Amnt As String

    'Assign the control's value to the variables
    TeamLead = TxtTeamLead.Value
    BusinessUnit = ComboBU.Value
    Category = ComboCategory.Value
    Subcategory = ComboSubcategory.Value
    Payee = TxtPayee.Value
    Description = TxtDescription.Value
    Budget = TxtBudget.Value
    PONumber = TxtPONbr.Value
    Invoice1Nbr = TxtInvoice1Nbr.Value
    Invoice1Date = TxtInvoice1Date.Value
    Invoice1Amnt = TxtInvoice1Amnt.Value
    Invoice2Nbr = TxtInvoice2Nbr.Value
    Invoice2Date = TxtInvoice2Date.Value
    Invoice2Amnt = TxtInvoice2Amnt.Value
    Invoice3Nbr = TxtInvoice3Nbr.Value
    Invoice3Date = TxtInvoice3Date.Value
    Invoice3Amnt = TxtInvoice3Amnt.Value
    
    'Declare worksheet variable
    Dim rSh As Worksheet
    On Error Resume Next
    Set rSh = ThisWorkbook.Sheets(Me.ComboBU.Value)
    On Error GoTo 0
    
    If rSh Is Nothing Then
        MsgBox "Please Select a Business Unit", vbCritical
        Exit Sub
    End If
    
    'If is new record
    'Get the next available row
    Dim nextRow As Long
    If Label2 = "True" Then
      nextRow = updateRow
    Else
      nextRow = rSh.Range("A" & Rows.Count).End(xlUp).Row + 1
    End If
    
    'Assign columns
    rSh.Range("A" & nextRow).Value = TeamLead
    rSh.Range("B" & nextRow).Value = Category
    rSh.Range("C" & nextRow).Value = Subcategory
    rSh.Range("E" & nextRow).Value = Payee
    rSh.Range("F" & nextRow).Value = Description
    rSh.Range("G" & nextRow).Value = Budget
    rSh.Range("H" & nextRow).Value = PONumber
    rSh.Range("I" & nextRow).Value = Invoice1Nbr
    rSh.Range("J" & nextRow).Value = Invoice1Date
    rSh.Range("K" & nextRow).Value = Invoice1Amnt
    rSh.Range("L" & nextRow).Value = Invoice2Nbr
    rSh.Range("M" & nextRow).Value = Invoice2Date
    rSh.Range("N" & nextRow).Value = Invoice2Amnt
    rSh.Range("O" & nextRow).Value = Invoice3Nbr
    rSh.Range("P" & nextRow).Value = Invoice3Date
    rSh.Range("Q" & nextRow).Value = Invoice3Amnt

    MsgBox "Updated "

'    Unload Me
    clearForm
End Sub

Sub clearForm()
    TxtTeamLead = ""
    ComboBU = ""
    ComboCategory = ""
    ComboSubcategory = ""
    TxtExpenseAcct = ""
    
    TxtPayee = ""
    TxtDescription = ""
    TxtBudget = ""
    
    TxtPONbr = ""
    TxtInvoice1Nbr = ""
    TxtInvoice1Date = ""
    TxtInvoice1Amnt = ""
    
    TxtInvoice2Nbr = ""
    TxtInvoice2Date = ""
    TxtInvoice2Amnt = ""
    
    TxtInvoice3Nbr = ""
    TxtInvoice3Date = ""
    TxtInvoice3Amnt = ""
    
    TxtInvoiceTotal = ""

    Label2 = ""
    ComboBU.Enabled = True
    TxtTeamLead.Enabled = True
    TxtTeamLead.SetFocus
End Sub



Private Sub TxtBudget_AfterUpdate()

    TxtBudget.Text = Format(TxtBudget, "$#,##0.00")

End Sub


Private Sub TxtInvoice1Amnt_AfterUpdate()

    TxtInvoice1Amnt.Text = Format(TxtInvoice1Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice1Date_AfterUpdate()

    TxtInvoice1Date.Text = Format(TxtInvoice1Date, "##/##/####")

    If IsDate(TxtInvoice1Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice1Date.Text = Empty

End If

End Sub


Private Sub TxtInvoice2Amnt_AfterUpdate()

    TxtInvoice2Amnt.Text = Format(TxtInvoice2Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice2Date_AfterUpdate()

    TxtInvoice2Date.Text = Format(TxtInvoice2Date, "##/##/####")

    If IsDate(TxtInvoice2Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice2Date.Text = Empty

End If

End Sub


Private Sub TxtInvoice3Amnt_AfterUpdate()

    TxtInvoice3Amnt.Text = Format(TxtInvoice3Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice3Date_AfterUpdate()

    TxtInvoice3Date.Text = Format(TxtInvoice3Date, "##/##/####")

    If IsDate(TxtInvoice3Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice3Date.Text = Empty

End If

End Sub


Private Sub TxtInvoiceTotal_AfterUpdate()

    TxtInvoiceTotal.Text = Format(TxtInvoiceTotal, "$#,##0.00")

End Sub

Code for userform:OpenExistingForm

Option Explicit
Dim a As Variant

Private Sub ComboLookup_Change()
  Call Filter_Data
End Sub

Private Sub TxtKeywords_Change()
  Call Filter_Data
End Sub

Sub Filter_Data()
  Dim i As Long, j As Long, k As Long
  Dim tbox As String, cbox As String, cad As String
  Dim col As Long

  Me.lbxResults.Clear
  k = 0
  With ComboLookup
    If .ListIndex > -1 Then
      Select Case .ListIndex
        Case 0: col = 1
        Case 1: col = 2
        Case 2: col = 3
        Case 3: col = 5
        Case 4: col = 8
      End Select
    Else
      col = 0
    End If
  End With
  
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    If col = 0 Then
      cad = "|" & LCase(a(i, 1)) & "|" & LCase(a(i, 2)) & "|" & LCase(a(i, 3)) & "|" & LCase(a(i, 4)) & "|" & LCase(a(i, 5)) & "|"
    Else
      cad = LCase(a(i, col))
    End If
    
    If TxtKeywords.Value = "" Then tbox = cad Else tbox = LCase(TxtKeywords.Value)
    
    If cad Like "*" & tbox & "*" Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    End If
  Next
  
  Me.lbxResults.List = b
End Sub

Private Sub lbxResults_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim shName As String
  Dim nRow As Long
 
  With lbxResults
    shName = .List(.ListIndex, .ColumnCount - 2)
    nRow = .List(.ListIndex, .ColumnCount - 1)
    'MsgBox "Sheet : " & shName & vbCr & "Row: " & nRow
    'Unload Me
    
    RequestForm.TxtTeamLead = .List(.ListIndex, 0)
    RequestForm.ComboBU = .List(.ListIndex, 19)
    RequestForm.ComboCategory = .List(.ListIndex, 1)
    RequestForm.ComboSubcategory = .List(.ListIndex, 2)
    
'    RequestForm.TxtExpenseAcct.Enabled = True
'    RequestForm.TxtExpenseAcct = .List(.ListIndex, 3)
'    RequestForm.TxtExpenseAcct.Enabled = False
    
    RequestForm.TxtPayee = .List(.ListIndex, 4)
    RequestForm.TxtDescription = .List(.ListIndex, 5)
    RequestForm.TxtBudget = .List(.ListIndex, 6)
    
    RequestForm.TxtPONbr = .List(.ListIndex, 7)
    RequestForm.TxtInvoice1Nbr = .List(.ListIndex, 8)
    RequestForm.TxtInvoice1Date = .List(.ListIndex, 9)
    RequestForm.TxtInvoice1Amnt = .List(.ListIndex, 10)
    
    RequestForm.TxtInvoice2Nbr = .List(.ListIndex, 11)
    RequestForm.TxtInvoice2Date = .List(.ListIndex, 12)
    RequestForm.TxtInvoice2Amnt = .List(.ListIndex, 13)
    
    RequestForm.TxtInvoice3Nbr = .List(.ListIndex, 14)
    RequestForm.TxtInvoice3Date = .List(.ListIndex, 15)
    RequestForm.TxtInvoice3Amnt = .List(.ListIndex, 16)
    
    RequestForm.TxtInvoiceTotal = .List(.ListIndex, 17)
    
    RequestForm.Label2 = "True"
    RequestForm.ComboBU.Enabled = False
    RequestForm.TxtTeamLead.Enabled = False
    RequestForm.updateRow = .List(.ListIndex, 20)
    
    Unload Me
  End With
End Sub

Private Sub UserForm_Activate()
  Dim b As Variant
  Dim sh As Worksheet
  Dim arr As Variant, itm As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, nMax As Long
  Dim col As String
 
  arr = Array("Enterprise", "MI", "Title", "Real Estate", "Conduit", "Corp Comm", "Events")
  
  With lbxResults
    col = "S"
    .ColumnCount = Columns(col).Column + 2
    '                A   B   C   D E   F G H   I J K L M N O P Q R S
    .ColumnWidths = "130;130;130;0;130;0;0;100;0;0;0;0;0;0;0;0;0;0;0;80;0"
    .Clear
  End With
  
  With ListBox1
    .ColumnCount = 6
    .ColumnWidths = "130;130;130;130;100;80"
    .Column = Application.Transpose(Array("Team Lead", "Category", "Subcategory", "Payee", "PO Number", "Sheet Name"))
  End With
  
  k = 0
  For Each itm In arr
    Set sh = Sheets(itm)
    lr = sh.Range("C" & Rows.Count).End(3).Row
    nMax = nMax + lr - 16
  Next
  ReDim a(1 To nMax, 1 To Columns(col).Column + 2)
  
  For Each itm In arr
    Set sh = Sheets(itm)
    lr = sh.Range("C" & Rows.Count).End(3).Row
    b = sh.Range("A17:" & col & lr).Value
    For i = 1 To UBound(b, 1)
      k = k + 1
      For j = 1 To UBound(b, 2)
        a(k, j) = b(i, j)
      Next
      a(k, UBound(a, 2) - 1) = sh.Name
      a(k, UBound(a, 2)) = i + 16
    Next
  Next
  lbxResults.List = a
End Sub

Private Sub ButtonSearch_Click()
  'Verify Lookup Field and Keyword(s) are not empty
  If ComboLookup.Value = "" Then
    MsgBox "Please Select a Lookup Field", vbCritical
    Exit Sub
  End If
  If TxtKeywords = "" Then
    MsgBox "Please Enter a Search Criteria", vbCritical
    Exit Sub
  End If
  
  
End Sub

Private Sub UserForm_Initialize()
  ComboLookup.List = Array("Team Lead", "Category", "Subcategory", "Payee", "PO Number")
  ComboLookup.SetFocus
End Sub

I am attaching your file with all the changes so you can try it.

Budget - TEST dam v2.xlsm

drive.google.com

 

[ExcelEndeavor]

Hi @ExcelEndeavor, Review all changes.

For 2 userforms to work, several changes are necessary in the 2 userforms.

The main form is going to be RequestForm

View attachment 121617​

I added the "Open Form to Search" button to open the "OpenExistingForm" form, perform the search, select the record to edit, modify. Press "Submit" and modify the selected record.
I also added a Label at the end of the form to know if you are editing a record.

The "Add new records" functionality will work as normal.

Code for userform: RequestForm

Option Explicit

    Public updateRow As Long

Private Sub ButtonCancel_Click()

    Unload Me

End Sub


Private Sub ComboBU_Change()

End Sub

Private Sub ComboCategory_Change()

    Select Case ComboCategory.Value
        Case Is = "Advertising"
            ComboSubcategory.RowSource = "Advertising"
        Case Is = "Public Relations"
            ComboSubcategory.RowSource = "Public_Relations"
        Case Is = "Software Expense"
            ComboSubcategory.RowSource = "Software_Expense"
        Case Is = "Outside Services"
            ComboSubcategory.RowSource = "Outside_Services"

End Select

End Sub


Private Sub ComboSubcategory_Change()
 
  If Me.ComboSubcategory.Value <> "" Then
    Me.TxtExpenseAcct.Value = Application.WorksheetFunction.VLookup(Me.ComboSubcategory.Value, Sheet9.Range("A:B"), 2, 0)
  End If
End Sub

Private Sub CommandButton1_Click()
  OpenExistingForm.Show
End Sub

Private Sub SubmitButton_Click()

    'Message Boxes for Required Fields
    If TxtTeamLead.Value = "" Then
        MsgBox "Please Enter the Team Lead Name", vbCritical
        Exit Sub
    End If
   
    If ComboCategory.Value = "" Then
        MsgBox "Please Select a Category", vbCritical
        Exit Sub
    End If
   
    If ComboSubcategory.Value = "" Then
        MsgBox "Please Select a Subcategory", vbCritical
        Exit Sub
    End If

    If TxtPayee.Value = "" Then
        MsgBox "Please Enter a Payee or Vendor", vbCritical
        Exit Sub
    End If

    If TxtDescription.Value = "" Then
        MsgBox "Please Provide a Description of the Project", vbCritical
        Exit Sub
    End If
   
    If TxtBudget.Value = "" Then
        MsgBox "Please Enter a Budget for the Project", vbCritical
        Exit Sub
    End If

    'Create variable for each detail - Requestor Information
    Dim TeamLead As String
    Dim BusinessUnit As String
    Dim Category As String
    Dim Subcategory As String
   
    'Create variable for each detail - Project Details
    Dim Payee As String
    Dim Description As String
    Dim Budget As String
   
    'Create variable for each detail - PO/Invoice Details
    Dim PONumber As String
    Dim Invoice1Nbr As String
    Dim Invoice1Date As String
    Dim Invoice1Amnt As String
    Dim Invoice2Nbr As String
    Dim Invoice2Date As String
    Dim Invoice2Amnt As String
    Dim Invoice3Nbr As String
    Dim Invoice3Date As String
    Dim Invoice3Amnt As String

    'Assign the control's value to the variables
    TeamLead = TxtTeamLead.Value
    BusinessUnit = ComboBU.Value
    Category = ComboCategory.Value
    Subcategory = ComboSubcategory.Value
    Payee = TxtPayee.Value
    Description = TxtDescription.Value
    Budget = TxtBudget.Value
    PONumber = TxtPONbr.Value
    Invoice1Nbr = TxtInvoice1Nbr.Value
    Invoice1Date = TxtInvoice1Date.Value
    Invoice1Amnt = TxtInvoice1Amnt.Value
    Invoice2Nbr = TxtInvoice2Nbr.Value
    Invoice2Date = TxtInvoice2Date.Value
    Invoice2Amnt = TxtInvoice2Amnt.Value
    Invoice3Nbr = TxtInvoice3Nbr.Value
    Invoice3Date = TxtInvoice3Date.Value
    Invoice3Amnt = TxtInvoice3Amnt.Value
   
    'Declare worksheet variable
    Dim rSh As Worksheet
    On Error Resume Next
    Set rSh = ThisWorkbook.Sheets(Me.ComboBU.Value)
    On Error GoTo 0
   
    If rSh Is Nothing Then
        MsgBox "Please Select a Business Unit", vbCritical
        Exit Sub
    End If
   
    'If is new record
    'Get the next available row
    Dim nextRow As Long
    If Label2 = "True" Then
      nextRow = updateRow
    Else
      nextRow = rSh.Range("A" & Rows.Count).End(xlUp).Row + 1
    End If
   
    'Assign columns
    rSh.Range("A" & nextRow).Value = TeamLead
    rSh.Range("B" & nextRow).Value = Category
    rSh.Range("C" & nextRow).Value = Subcategory
    rSh.Range("E" & nextRow).Value = Payee
    rSh.Range("F" & nextRow).Value = Description
    rSh.Range("G" & nextRow).Value = Budget
    rSh.Range("H" & nextRow).Value = PONumber
    rSh.Range("I" & nextRow).Value = Invoice1Nbr
    rSh.Range("J" & nextRow).Value = Invoice1Date
    rSh.Range("K" & nextRow).Value = Invoice1Amnt
    rSh.Range("L" & nextRow).Value = Invoice2Nbr
    rSh.Range("M" & nextRow).Value = Invoice2Date
    rSh.Range("N" & nextRow).Value = Invoice2Amnt
    rSh.Range("O" & nextRow).Value = Invoice3Nbr
    rSh.Range("P" & nextRow).Value = Invoice3Date
    rSh.Range("Q" & nextRow).Value = Invoice3Amnt

    MsgBox "Updated "

'    Unload Me
    clearForm
End Sub

Sub clearForm()
    TxtTeamLead = ""
    ComboBU = ""
    ComboCategory = ""
    ComboSubcategory = ""
    TxtExpenseAcct = ""
   
    TxtPayee = ""
    TxtDescription = ""
    TxtBudget = ""
   
    TxtPONbr = ""
    TxtInvoice1Nbr = ""
    TxtInvoice1Date = ""
    TxtInvoice1Amnt = ""
   
    TxtInvoice2Nbr = ""
    TxtInvoice2Date = ""
    TxtInvoice2Amnt = ""
   
    TxtInvoice3Nbr = ""
    TxtInvoice3Date = ""
    TxtInvoice3Amnt = ""
   
    TxtInvoiceTotal = ""

    Label2 = ""
    ComboBU.Enabled = True
    TxtTeamLead.Enabled = True
    TxtTeamLead.SetFocus
End Sub



Private Sub TxtBudget_AfterUpdate()

    TxtBudget.Text = Format(TxtBudget, "$#,##0.00")

End Sub


Private Sub TxtInvoice1Amnt_AfterUpdate()

    TxtInvoice1Amnt.Text = Format(TxtInvoice1Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice1Date_AfterUpdate()

    TxtInvoice1Date.Text = Format(TxtInvoice1Date, "##/##/####")

    If IsDate(TxtInvoice1Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice1Date.Text = Empty

End If

End Sub


Private Sub TxtInvoice2Amnt_AfterUpdate()

    TxtInvoice2Amnt.Text = Format(TxtInvoice2Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice2Date_AfterUpdate()

    TxtInvoice2Date.Text = Format(TxtInvoice2Date, "##/##/####")

    If IsDate(TxtInvoice2Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice2Date.Text = Empty

End If

End Sub


Private Sub TxtInvoice3Amnt_AfterUpdate()

    TxtInvoice3Amnt.Text = Format(TxtInvoice3Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice3Date_AfterUpdate()

    TxtInvoice3Date.Text = Format(TxtInvoice3Date, "##/##/####")

    If IsDate(TxtInvoice3Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice3Date.Text = Empty

End If

End Sub


Private Sub TxtInvoiceTotal_AfterUpdate()

    TxtInvoiceTotal.Text = Format(TxtInvoiceTotal, "$#,##0.00")

End Sub

Code for userform:OpenExistingForm

Option Explicit
Dim a As Variant

Private Sub ComboLookup_Change()
  Call Filter_Data
End Sub

Private Sub TxtKeywords_Change()
  Call Filter_Data
End Sub

Sub Filter_Data()
  Dim i As Long, j As Long, k As Long
  Dim tbox As String, cbox As String, cad As String
  Dim col As Long

  Me.lbxResults.Clear
  k = 0
  With ComboLookup
    If .ListIndex > -1 Then
      Select Case .ListIndex
        Case 0: col = 1
        Case 1: col = 2
        Case 2: col = 3
        Case 3: col = 5
        Case 4: col = 8
      End Select
    Else
      col = 0
    End If
  End With
 
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    If col = 0 Then
      cad = "|" & LCase(a(i, 1)) & "|" & LCase(a(i, 2)) & "|" & LCase(a(i, 3)) & "|" & LCase(a(i, 4)) & "|" & LCase(a(i, 5)) & "|"
    Else
      cad = LCase(a(i, col))
    End If
   
    If TxtKeywords.Value = "" Then tbox = cad Else tbox = LCase(TxtKeywords.Value)
   
    If cad Like "*" & tbox & "*" Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    End If
  Next
 
  Me.lbxResults.List = b
End Sub

Private Sub lbxResults_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim shName As String
  Dim nRow As Long
 
  With lbxResults
    shName = .List(.ListIndex, .ColumnCount - 2)
    nRow = .List(.ListIndex, .ColumnCount - 1)
    'MsgBox "Sheet : " & shName & vbCr & "Row: " & nRow
    'Unload Me
   
    RequestForm.TxtTeamLead = .List(.ListIndex, 0)
    RequestForm.ComboBU = .List(.ListIndex, 19)
    RequestForm.ComboCategory = .List(.ListIndex, 1)
    RequestForm.ComboSubcategory = .List(.ListIndex, 2)
   
'    RequestForm.TxtExpenseAcct.Enabled = True
'    RequestForm.TxtExpenseAcct = .List(.ListIndex, 3)
'    RequestForm.TxtExpenseAcct.Enabled = False
   
    RequestForm.TxtPayee = .List(.ListIndex, 4)
    RequestForm.TxtDescription = .List(.ListIndex, 5)
    RequestForm.TxtBudget = .List(.ListIndex, 6)
   
    RequestForm.TxtPONbr = .List(.ListIndex, 7)
    RequestForm.TxtInvoice1Nbr = .List(.ListIndex, 8)
    RequestForm.TxtInvoice1Date = .List(.ListIndex, 9)
    RequestForm.TxtInvoice1Amnt = .List(.ListIndex, 10)
   
    RequestForm.TxtInvoice2Nbr = .List(.ListIndex, 11)
    RequestForm.TxtInvoice2Date = .List(.ListIndex, 12)
    RequestForm.TxtInvoice2Amnt = .List(.ListIndex, 13)
   
    RequestForm.TxtInvoice3Nbr = .List(.ListIndex, 14)
    RequestForm.TxtInvoice3Date = .List(.ListIndex, 15)
    RequestForm.TxtInvoice3Amnt = .List(.ListIndex, 16)
   
    RequestForm.TxtInvoiceTotal = .List(.ListIndex, 17)
   
    RequestForm.Label2 = "True"
    RequestForm.ComboBU.Enabled = False
    RequestForm.TxtTeamLead.Enabled = False
    RequestForm.updateRow = .List(.ListIndex, 20)
   
    Unload Me
  End With
End Sub

Private Sub UserForm_Activate()
  Dim b As Variant
  Dim sh As Worksheet
  Dim arr As Variant, itm As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, nMax As Long
  Dim col As String
 
  arr = Array("Enterprise", "MI", "Title", "Real Estate", "Conduit", "Corp Comm", "Events")
 
  With lbxResults
    col = "S"
    .ColumnCount = Columns(col).Column + 2
    '                A   B   C   D E   F G H   I J K L M N O P Q R S
    .ColumnWidths = "130;130;130;0;130;0;0;100;0;0;0;0;0;0;0;0;0;0;0;80;0"
    .Clear
  End With
 
  With ListBox1
    .ColumnCount = 6
    .ColumnWidths = "130;130;130;130;100;80"
    .Column = Application.Transpose(Array("Team Lead", "Category", "Subcategory", "Payee", "PO Number", "Sheet Name"))
  End With
 
  k = 0
  For Each itm In arr
    Set sh = Sheets(itm)
    lr = sh.Range("C" & Rows.Count).End(3).Row
    nMax = nMax + lr - 16
  Next
  ReDim a(1 To nMax, 1 To Columns(col).Column + 2)
 
  For Each itm In arr
    Set sh = Sheets(itm)
    lr = sh.Range("C" & Rows.Count).End(3).Row
    b = sh.Range("A17:" & col & lr).Value
    For i = 1 To UBound(b, 1)
      k = k + 1
      For j = 1 To UBound(b, 2)
        a(k, j) = b(i, j)
      Next
      a(k, UBound(a, 2) - 1) = sh.Name
      a(k, UBound(a, 2)) = i + 16
    Next
  Next
  lbxResults.List = a
End Sub

Private Sub ButtonSearch_Click()
  'Verify Lookup Field and Keyword(s) are not empty
  If ComboLookup.Value = "" Then
    MsgBox "Please Select a Lookup Field", vbCritical
    Exit Sub
  End If
  If TxtKeywords = "" Then
    MsgBox "Please Enter a Search Criteria", vbCritical
    Exit Sub
  End If
 
 
End Sub

Private Sub UserForm_Initialize()
  ComboLookup.List = Array("Team Lead", "Category", "Subcategory", "Payee", "PO Number")
  ComboLookup.SetFocus
End Sub

I am attaching your file with all the changes so you can try it.

Budget - TEST dam v2.xlsm

drive.google.com

Holy cow - thank you so much. I think this is perfect. Thank you again

 

[ExcelEndeavor]

Hi @ExcelEndeavor, Review all changes.

For 2 userforms to work, several changes are necessary in the 2 userforms.

The main form is going to be RequestForm

View attachment 121617​

I added the "Open Form to Search" button to open the "OpenExistingForm" form, perform the search, select the record to edit, modify. Press "Submit" and modify the selected record.
I also added a Label at the end of the form to know if you are editing a record.

The "Add new records" functionality will work as normal.

Code for userform: RequestForm

Option Explicit

    Public updateRow As Long

Private Sub ButtonCancel_Click()

    Unload Me

End Sub


Private Sub ComboBU_Change()

End Sub

Private Sub ComboCategory_Change()

    Select Case ComboCategory.Value
        Case Is = "Advertising"
            ComboSubcategory.RowSource = "Advertising"
        Case Is = "Public Relations"
            ComboSubcategory.RowSource = "Public_Relations"
        Case Is = "Software Expense"
            ComboSubcategory.RowSource = "Software_Expense"
        Case Is = "Outside Services"
            ComboSubcategory.RowSource = "Outside_Services"

End Select

End Sub


Private Sub ComboSubcategory_Change()
 
  If Me.ComboSubcategory.Value <> "" Then
    Me.TxtExpenseAcct.Value = Application.WorksheetFunction.VLookup(Me.ComboSubcategory.Value, Sheet9.Range("A:B"), 2, 0)
  End If
End Sub

Private Sub CommandButton1_Click()
  OpenExistingForm.Show
End Sub

Private Sub SubmitButton_Click()

    'Message Boxes for Required Fields
    If TxtTeamLead.Value = "" Then
        MsgBox "Please Enter the Team Lead Name", vbCritical
        Exit Sub
    End If
   
    If ComboCategory.Value = "" Then
        MsgBox "Please Select a Category", vbCritical
        Exit Sub
    End If
   
    If ComboSubcategory.Value = "" Then
        MsgBox "Please Select a Subcategory", vbCritical
        Exit Sub
    End If

    If TxtPayee.Value = "" Then
        MsgBox "Please Enter a Payee or Vendor", vbCritical
        Exit Sub
    End If

    If TxtDescription.Value = "" Then
        MsgBox "Please Provide a Description of the Project", vbCritical
        Exit Sub
    End If
   
    If TxtBudget.Value = "" Then
        MsgBox "Please Enter a Budget for the Project", vbCritical
        Exit Sub
    End If

    'Create variable for each detail - Requestor Information
    Dim TeamLead As String
    Dim BusinessUnit As String
    Dim Category As String
    Dim Subcategory As String
   
    'Create variable for each detail - Project Details
    Dim Payee As String
    Dim Description As String
    Dim Budget As String
   
    'Create variable for each detail - PO/Invoice Details
    Dim PONumber As String
    Dim Invoice1Nbr As String
    Dim Invoice1Date As String
    Dim Invoice1Amnt As String
    Dim Invoice2Nbr As String
    Dim Invoice2Date As String
    Dim Invoice2Amnt As String
    Dim Invoice3Nbr As String
    Dim Invoice3Date As String
    Dim Invoice3Amnt As String

    'Assign the control's value to the variables
    TeamLead = TxtTeamLead.Value
    BusinessUnit = ComboBU.Value
    Category = ComboCategory.Value
    Subcategory = ComboSubcategory.Value
    Payee = TxtPayee.Value
    Description = TxtDescription.Value
    Budget = TxtBudget.Value
    PONumber = TxtPONbr.Value
    Invoice1Nbr = TxtInvoice1Nbr.Value
    Invoice1Date = TxtInvoice1Date.Value
    Invoice1Amnt = TxtInvoice1Amnt.Value
    Invoice2Nbr = TxtInvoice2Nbr.Value
    Invoice2Date = TxtInvoice2Date.Value
    Invoice2Amnt = TxtInvoice2Amnt.Value
    Invoice3Nbr = TxtInvoice3Nbr.Value
    Invoice3Date = TxtInvoice3Date.Value
    Invoice3Amnt = TxtInvoice3Amnt.Value
   
    'Declare worksheet variable
    Dim rSh As Worksheet
    On Error Resume Next
    Set rSh = ThisWorkbook.Sheets(Me.ComboBU.Value)
    On Error GoTo 0
   
    If rSh Is Nothing Then
        MsgBox "Please Select a Business Unit", vbCritical
        Exit Sub
    End If
   
    'If is new record
    'Get the next available row
    Dim nextRow As Long
    If Label2 = "True" Then
      nextRow = updateRow
    Else
      nextRow = rSh.Range("A" & Rows.Count).End(xlUp).Row + 1
    End If
   
    'Assign columns
    rSh.Range("A" & nextRow).Value = TeamLead
    rSh.Range("B" & nextRow).Value = Category
    rSh.Range("C" & nextRow).Value = Subcategory
    rSh.Range("E" & nextRow).Value = Payee
    rSh.Range("F" & nextRow).Value = Description
    rSh.Range("G" & nextRow).Value = Budget
    rSh.Range("H" & nextRow).Value = PONumber
    rSh.Range("I" & nextRow).Value = Invoice1Nbr
    rSh.Range("J" & nextRow).Value = Invoice1Date
    rSh.Range("K" & nextRow).Value = Invoice1Amnt
    rSh.Range("L" & nextRow).Value = Invoice2Nbr
    rSh.Range("M" & nextRow).Value = Invoice2Date
    rSh.Range("N" & nextRow).Value = Invoice2Amnt
    rSh.Range("O" & nextRow).Value = Invoice3Nbr
    rSh.Range("P" & nextRow).Value = Invoice3Date
    rSh.Range("Q" & nextRow).Value = Invoice3Amnt

    MsgBox "Updated "

'    Unload Me
    clearForm
End Sub

Sub clearForm()
    TxtTeamLead = ""
    ComboBU = ""
    ComboCategory = ""
    ComboSubcategory = ""
    TxtExpenseAcct = ""
   
    TxtPayee = ""
    TxtDescription = ""
    TxtBudget = ""
   
    TxtPONbr = ""
    TxtInvoice1Nbr = ""
    TxtInvoice1Date = ""
    TxtInvoice1Amnt = ""
   
    TxtInvoice2Nbr = ""
    TxtInvoice2Date = ""
    TxtInvoice2Amnt = ""
   
    TxtInvoice3Nbr = ""
    TxtInvoice3Date = ""
    TxtInvoice3Amnt = ""
   
    TxtInvoiceTotal = ""

    Label2 = ""
    ComboBU.Enabled = True
    TxtTeamLead.Enabled = True
    TxtTeamLead.SetFocus
End Sub



Private Sub TxtBudget_AfterUpdate()

    TxtBudget.Text = Format(TxtBudget, "$#,##0.00")

End Sub


Private Sub TxtInvoice1Amnt_AfterUpdate()

    TxtInvoice1Amnt.Text = Format(TxtInvoice1Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice1Date_AfterUpdate()

    TxtInvoice1Date.Text = Format(TxtInvoice1Date, "##/##/####")

    If IsDate(TxtInvoice1Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice1Date.Text = Empty

End If

End Sub


Private Sub TxtInvoice2Amnt_AfterUpdate()

    TxtInvoice2Amnt.Text = Format(TxtInvoice2Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice2Date_AfterUpdate()

    TxtInvoice2Date.Text = Format(TxtInvoice2Date, "##/##/####")

    If IsDate(TxtInvoice2Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice2Date.Text = Empty

End If

End Sub


Private Sub TxtInvoice3Amnt_AfterUpdate()

    TxtInvoice3Amnt.Text = Format(TxtInvoice3Amnt, "$#,##0.00")

End Sub


Private Sub TxtInvoice3Date_AfterUpdate()

    TxtInvoice3Date.Text = Format(TxtInvoice3Date, "##/##/####")

    If IsDate(TxtInvoice3Date.Text) Then

Else
    MsgBox "Please Enter A Valid Date", vbInformation
    TxtInvoice3Date.Text = Empty

End If

End Sub


Private Sub TxtInvoiceTotal_AfterUpdate()

    TxtInvoiceTotal.Text = Format(TxtInvoiceTotal, "$#,##0.00")

End Sub

Code for userform:OpenExistingForm

Option Explicit
Dim a As Variant

Private Sub ComboLookup_Change()
  Call Filter_Data
End Sub

Private Sub TxtKeywords_Change()
  Call Filter_Data
End Sub

Sub Filter_Data()
  Dim i As Long, j As Long, k As Long
  Dim tbox As String, cbox As String, cad As String
  Dim col As Long

  Me.lbxResults.Clear
  k = 0
  With ComboLookup
    If .ListIndex > -1 Then
      Select Case .ListIndex
        Case 0: col = 1
        Case 1: col = 2
        Case 2: col = 3
        Case 3: col = 5
        Case 4: col = 8
      End Select
    Else
      col = 0
    End If
  End With
 
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    If col = 0 Then
      cad = "|" & LCase(a(i, 1)) & "|" & LCase(a(i, 2)) & "|" & LCase(a(i, 3)) & "|" & LCase(a(i, 4)) & "|" & LCase(a(i, 5)) & "|"
    Else
      cad = LCase(a(i, col))
    End If
   
    If TxtKeywords.Value = "" Then tbox = cad Else tbox = LCase(TxtKeywords.Value)
   
    If cad Like "*" & tbox & "*" Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    End If
  Next
 
  Me.lbxResults.List = b
End Sub

Private Sub lbxResults_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim shName As String
  Dim nRow As Long
 
  With lbxResults
    shName = .List(.ListIndex, .ColumnCount - 2)
    nRow = .List(.ListIndex, .ColumnCount - 1)
    'MsgBox "Sheet : " & shName & vbCr & "Row: " & nRow
    'Unload Me
   
    RequestForm.TxtTeamLead = .List(.ListIndex, 0)
    RequestForm.ComboBU = .List(.ListIndex, 19)
    RequestForm.ComboCategory = .List(.ListIndex, 1)
    RequestForm.ComboSubcategory = .List(.ListIndex, 2)
   
'    RequestForm.TxtExpenseAcct.Enabled = True
'    RequestForm.TxtExpenseAcct = .List(.ListIndex, 3)
'    RequestForm.TxtExpenseAcct.Enabled = False
   
    RequestForm.TxtPayee = .List(.ListIndex, 4)
    RequestForm.TxtDescription = .List(.ListIndex, 5)
    RequestForm.TxtBudget = .List(.ListIndex, 6)
   
    RequestForm.TxtPONbr = .List(.ListIndex, 7)
    RequestForm.TxtInvoice1Nbr = .List(.ListIndex, 8)
    RequestForm.TxtInvoice1Date = .List(.ListIndex, 9)
    RequestForm.TxtInvoice1Amnt = .List(.ListIndex, 10)
   
    RequestForm.TxtInvoice2Nbr = .List(.ListIndex, 11)
    RequestForm.TxtInvoice2Date = .List(.ListIndex, 12)
    RequestForm.TxtInvoice2Amnt = .List(.ListIndex, 13)
   
    RequestForm.TxtInvoice3Nbr = .List(.ListIndex, 14)
    RequestForm.TxtInvoice3Date = .List(.ListIndex, 15)
    RequestForm.TxtInvoice3Amnt = .List(.ListIndex, 16)
   
    RequestForm.TxtInvoiceTotal = .List(.ListIndex, 17)
   
    RequestForm.Label2 = "True"
    RequestForm.ComboBU.Enabled = False
    RequestForm.TxtTeamLead.Enabled = False
    RequestForm.updateRow = .List(.ListIndex, 20)
   
    Unload Me
  End With
End Sub

Private Sub UserForm_Activate()
  Dim b As Variant
  Dim sh As Worksheet
  Dim arr As Variant, itm As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, nMax As Long
  Dim col As String
 
  arr = Array("Enterprise", "MI", "Title", "Real Estate", "Conduit", "Corp Comm", "Events")
 
  With lbxResults
    col = "S"
    .ColumnCount = Columns(col).Column + 2
    '                A   B   C   D E   F G H   I J K L M N O P Q R S
    .ColumnWidths = "130;130;130;0;130;0;0;100;0;0;0;0;0;0;0;0;0;0;0;80;0"
    .Clear
  End With
 
  With ListBox1
    .ColumnCount = 6
    .ColumnWidths = "130;130;130;130;100;80"
    .Column = Application.Transpose(Array("Team Lead", "Category", "Subcategory", "Payee", "PO Number", "Sheet Name"))
  End With
 
  k = 0
  For Each itm In arr
    Set sh = Sheets(itm)
    lr = sh.Range("C" & Rows.Count).End(3).Row
    nMax = nMax + lr - 16
  Next
  ReDim a(1 To nMax, 1 To Columns(col).Column + 2)
 
  For Each itm In arr
    Set sh = Sheets(itm)
    lr = sh.Range("C" & Rows.Count).End(3).Row
    b = sh.Range("A17:" & col & lr).Value
    For i = 1 To UBound(b, 1)
      k = k + 1
      For j = 1 To UBound(b, 2)
        a(k, j) = b(i, j)
      Next
      a(k, UBound(a, 2) - 1) = sh.Name
      a(k, UBound(a, 2)) = i + 16
    Next
  Next
  lbxResults.List = a
End Sub

Private Sub ButtonSearch_Click()
  'Verify Lookup Field and Keyword(s) are not empty
  If ComboLookup.Value = "" Then
    MsgBox "Please Select a Lookup Field", vbCritical
    Exit Sub
  End If
  If TxtKeywords = "" Then
    MsgBox "Please Enter a Search Criteria", vbCritical
    Exit Sub
  End If
 
 
End Sub

Private Sub UserForm_Initialize()
  ComboLookup.List = Array("Team Lead", "Category", "Subcategory", "Payee", "PO Number")
  ComboLookup.SetFocus
End Sub

I am attaching your file with all the changes so you can try it.

Budget - TEST dam v2.xlsm

drive.google.com

 

[ExcelEndeavor]

Thank you for you help DanteAmor - I just have one last issue (I think). I have added a few items to the workbook with the handy userform. Now, when I go back to search existing items, I get a Run-time error '9' - Subscript out of range. When i click the Debug button, this part of the code pops up: What would be the cause of this?

 

[DanteAmor]

Holy cow - thank you so much. I think this is perfect. Thank you again

Now, when I go back to search existing items, I get a Run-time error '9' - Subscript out of range

From Friday's test to today, what changed in your data?
Did you modify the macro?
What other changes did you make?

Can you share your file on dropbox?

 

[ExcelEndeavor]

From Friday's test to today, what changed in your data?
Did you modify the macro?
What other changes did you make?

Can you share your file on dropbox?

I didn't make any changes to the macro, but I did add a few things:

- I added the accounting format to the worksheets for the invoice columns
- I added Module1 to sum the 3 invoices and flow to TxtInvoiceTotal in the RequestForm
- I locked each worksheet so formulas couldn’t be changed.

Here is the link to the updated file in Dropbox:

Dropbox Link

 

[DanteAmor]

I can't download that file.
Check the link and put it back here.