List All Matches in textbox VBA

new11

New Member
Joined
Sep 15, 2020
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hi guys,

I was just wondering if anyone might know the answer to a little problem I'm having below?

I have a userform for generating invoices that has a combobox (cbo_clientnr) that allows a client number to either be selected or searched for. I also have a checkbox (check_outstanding) that when pressed will search through a payment database to find a matching client number for any invoices that haven't been paid, and then sums all invoice amounts together for all matches found. Additionally, it also displays the invoice name in another textbox (tb_invoiceoutstanding)

This works fine but what I'm struggling to figure out is how to list all invoice numbers in the textbox (tb_invoiceoutstanding) at the moment it will only list 1 invoice number in the textbox.
Does anyone know how I am able to list all the invoice numbers in the textbox rather than only 1?


Any assistance or advice in the right direction would be really appreciated.
I hope my question makes sense, this was the only way I could think of explaining it.


VBA Code:
Private Sub check_outstanding_Click()

Dim payment_db As Worksheet
    Set payment_db = Sheets("payment_db")

Dim c As Long
Dim Rng As Range, Sel As Variant
   
    Sel = Me.cbo_clientnr.Value
    Set Rng = payment_db.Columns(4).Find(Sel, lookat:=xlWhole)

''##### if any of the cells in column"21U" is blank or contain "n or no" then start "Sel"  ########
    For c = 2 To payment_db.Range("D10000").End(xlUp).Row
        If payment_db.Cells(c, 4) = cbo_clientnr Then
            If payment_db.Cells(c, 21) = "" Or payment_db.Cells(c, 21) = "n" Or payment_db.Cells(c, 21) = "NO" Or payment_db.Cells(c, 21) = "no" _
                Or payment_db.Cells(c, 21) = "N" Or payment_db.Cells(c, 21) = "No" Then
                    If Sel <> "" Then    '###### using "cbo_clientnr" look for and find match in column "D" and then sum all matching values from column "I"  ############
                    If Not Rng Is Nothing Then
                                If check_outstanding = True Then
                                Me.existing_charge.Value = WorksheetFunction.SumIf(payment_db.Range("D:D"), Me.cbo_clientnr, payment_db.Range("I:I"))    '''### column D = client number to match with "cbo_clientnr" column I = invoice total to sum #####
                                    tb_invoiceoutstanding = payment_db.Cells(Rng, "B")   ''##### This is where I am trying to have all the matching invoice numbers get [I]listed (at the moment it only lists 1)[/I]
                                Else
                                If check_outstanding = False Then
                                existing_charge = ""
                                tb_invoiceoutstanding = ""
                                End If
                                End If
        End If
        End If
        End If
        End If
    Next c

End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Try replacing your tb_invoiceoutstanding = payment_db.Cells(Rng, "B") with
Code:
tb_invoiceoutstanding = Evaluate("TEXTJOIN(CHAR(10),TRUE, IF(payment_db!D1:D10000=" & Me.cbo_clientnr & ",payment_db!B1:B10000,""""))")
 
Upvote 0
Hi,
untested but see if this update to your code does what you want

VBA Code:
Private Sub check_outstanding_Click()
    
    Dim payment_db      As Worksheet
    
    Dim FoundCell       As Range, rngClientNo As Range
    Dim SearchClient    As Variant
    Dim FirstAddress    As String, Status As String
    
    If Not Me.check_outstanding Then
        
        Me.cbo_clientnr.Value = ""
        Me.existing_charge.Value = ""
        Me.tb_invoiceoutstanding.Value = ""
        
    Else
        
        SearchClient = Me.cbo_clientnr.Value
        If Len(SearchClient) = 0 Then Exit Sub
        
        Set payment_db = ThisWorkbook.Worksheets("payment_db")
        Set rngClientNo = payment_db.Columns(4)
        
        Set FoundCell = rngClientNo.Find(SearchClient, LookIn:=xlValues, lookat:=xlWhole)
        
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            
            Do
                Status = FoundCell.Offset(, 17).Value
                If Len(Status) = 0 Or UCase(Status) Like "N*" Then
                    '''invoice amount to sum #####
                    With Me.existing_charge
                        .Value = Val(.Value) + FoundCell.Offset(, 5).Value
                    End With
                    'outstanding invoice(s)
                    With Me.tb_invoiceoutstanding
                        .Value = .Value & FoundCell.Offset(, -2).Value & ", "
                    End With
                End If
                'next invoice
                Set FoundCell = rngClientNo.FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
                
            Loop While FirstAddress <> FoundCell.Address
            
        Else
            'inform user
            MsgBox SearchClient & Chr(10) & "Record Not Found", 48, "Not Found"
            
        End If
        
    End If
    
End Sub

Dave
 
Upvote 0
Solution
I realized my code (see my previous message) need to be corrected to
VBA Code:
tb_invoiceoutstanding = Evaluate("TEXTJOIN(CHAR(10),TRUE, IF(payment_db!D1:D10000=" & Chr(34) & Me.cbo_clientnr & Chr(34) & ",payment_db!B1:B10000,""""))")
Also, tb_invoiceoutstanding needs its Multiline property be set to True
 
Upvote 0
Hi,
untested but see if this update to your code does what you want

VBA Code:
Private Sub check_outstanding_Click()
   
    Dim payment_db      As Worksheet
   
    Dim FoundCell       As Range, rngClientNo As Range
    Dim SearchClient    As Variant
    Dim FirstAddress    As String, Status As String
   
    If Not Me.check_outstanding Then
       
        Me.cbo_clientnr.Value = ""
        Me.existing_charge.Value = ""
        Me.tb_invoiceoutstanding.Value = ""
       
    Else
       
        SearchClient = Me.cbo_clientnr.Value
        If Len(SearchClient) = 0 Then Exit Sub
       
        Set payment_db = ThisWorkbook.Worksheets("payment_db")
        Set rngClientNo = payment_db.Columns(4)
       
        Set FoundCell = rngClientNo.Find(SearchClient, LookIn:=xlValues, lookat:=xlWhole)
       
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
           
            Do
                Status = FoundCell.Offset(, 17).Value
                If Len(Status) = 0 Or UCase(Status) Like "N*" Then
                    '''invoice amount to sum #####
                    With Me.existing_charge
                        .Value = Val(.Value) + FoundCell.Offset(, 5).Value
                    End With
                    'outstanding invoice(s)
                    With Me.tb_invoiceoutstanding
                        .Value = .Value & FoundCell.Offset(, -2).Value & ", "
                    End With
                End If
                'next invoice
                Set FoundCell = rngClientNo.FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
               
            Loop While FirstAddress <> FoundCell.Address
           
        Else
            'inform user
            MsgBox SearchClient & Chr(10) & "Record Not Found", 48, "Not Found"
           
        End If
       
    End If
   
End Sub

Dave

You sir are an absolute genius! Not only does your piece of code work beautifully but it has answered a question I've been trying to figure out for years!! :)
I especially like the use of the "Or UCase(Status) Like "N*" Then" helping to cut out all the useless "if or" statements I had. How it was also all incorporated into a loop is great.

Thank you very much for this above-and-beyond answer!! :)
 
Upvote 0
I realized my code (see my previous message) need to be corrected to
VBA Code:
tb_invoiceoutstanding = Evaluate("TEXTJOIN(CHAR(10),TRUE, IF(payment_db!D1:D10000=" & Chr(34) & Me.cbo_clientnr & Chr(34) & ",payment_db!B1:B10000,""""))")
Also, tb_invoiceoutstanding needs its Multiline property be set to True
Thanks for the answer. After I had changed the format of some of the textboxes and a couple of other things, your solution had also worked too.
So thank you too, for your answer. :)
 
Upvote 0
Thank you very much for this above-and-beyond answer!! :)

glad we were able to help resolve your issue & I thank you for your generous feedback it is very much appreciated

Dave
 
Upvote 0
glad we were able to help resolve your issue & I thank you for your generous feedback it is very much appreciated

Dave
Hi Dave,
I know this is a separate question but would value your expert assistance, please.

I've taken a piece of your code and am using it for some userform validation but can't quite figure out how best to adapt it.

In the userform I have a few comboboxes allowing a user to select the; customer number (cbo_clientnr), the clients first name (cbo_firstname) & the clients last name (cbo_lastname)
What I'm trying to figure out is how to check that all three of the textboxes (cbo_clientnr, cbo_firstname & cbo_lastname) all match records in a sheets table.

This is the data I'm trying to validate the userform against
1661928285526.png

for example; if cbo_clientnr=CL1-WH2022 & cbo_firstname=Will & cbo_lastname=Hogan || this would be valid.
However, if if cbo_clientnr=CL1-WH2022 & cbo_firstname=Ant & cbo_lastname=Hogan || This would not be a valid entry because the FIRST name is different & the sub exits

This is the part of the code that I'm adapting. Works well if I use only one of; find_cn or find_fn or find_ln just not all three. Many thanks in advance for any assistance and or tips

VBA Code:
Dim client_db As Worksheet
Set client_db = Sheets("client_db")
Dim find_cn As String, find_fn As String, find_ln As String
find_cn = cbo_clientnr
find_fn = cbo_firstname
find_ln = cbo_lastname
If Trim(find_cn) <> "" And Trim(find_fn) <> "" And Trim(find_ln) <> "" Then
    With Sheets("client_db").Range("B:E")
            Set Rng2 = .Find(What:=find_cn & find_fn & find_ln, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not Rng2 Is Nothing Then
            Application.Goto Rng2, True 'value found
        Else
            MsgBox "THE SELECTION DOES NOT MATCH THE DATABASE!" & vbNewLine & vbNewLine & "Please either add a new a client or choose a valid client details from the list.", vbOKOnly + vbCritical
            Exit Sub
        End If
    End With
End If
 
Upvote 0
Really should start a new thread

What you want should largely be an adaption of solution I posted

VBA Code:
Sub Search()
    Dim find_cn     As String, find_fn As String
    Dim find_ln     As String, firstaddress As String
    Dim client_db   As Worksheet
    Dim FoundCell   As Range, SearchRange As Range
    
    Set client_db = ThisWorkbook.Worksheets("client_db")
    
    Set SearchRange = client_db.Range("B:B")
    
    find_cn = cbo_clientnr
    find_fn = cbo_firstname
    find_ln = cbo_lastname
    
    If Trim(find_cn) <> "" And Trim(find_fn) <> "" And Trim(find_ln) <> "" Then
        
        Set FoundCell = SearchRange.Find(What:=find_cn, LookIn:=xlValues, _
                                        LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                        SearchDirection:=xlNext, MatchCase:=False)
        If Not FoundCell Is Nothing Then
        'mark first match address
            firstaddress = FoundCell.Address
            Do
                With FoundCell
                'check first & last names for match
                    If .Offset(, 2) = find_fn And .Offset(, 3) = find_ln Then
                        'match
                        'do stuff
                        
                    End If
                End With
                Set FoundCell = SearchRange.FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
            Loop While firstaddress <> FoundCell.Address
            
        Else
            MsgBox "THE SELECTION DOES Not MATCH THE DATABASE!" & vbNewLine & vbNewLine & _
                   "Please either add a New a client Or choose a valid client details from the list.", _
                   16, "Record Not Found"
        End If
    End If
    
End Sub

Dave
 
Upvote 0
Really should start a new thread

What you want should largely be an adaption of solution I posted

VBA Code:
Sub Search()
    Dim find_cn     As String, find_fn As String
    Dim find_ln     As String, firstaddress As String
    Dim client_db   As Worksheet
    Dim FoundCell   As Range, SearchRange As Range
   
    Set client_db = ThisWorkbook.Worksheets("client_db")
   
    Set SearchRange = client_db.Range("B:B")
   
    find_cn = cbo_clientnr
    find_fn = cbo_firstname
    find_ln = cbo_lastname
   
    If Trim(find_cn) <> "" And Trim(find_fn) <> "" And Trim(find_ln) <> "" Then
       
        Set FoundCell = SearchRange.Find(What:=find_cn, LookIn:=xlValues, _
                                        LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                        SearchDirection:=xlNext, MatchCase:=False)
        If Not FoundCell Is Nothing Then
        'mark first match address
            firstaddress = FoundCell.Address
            Do
                With FoundCell
                'check first & last names for match
                    If .Offset(, 2) = find_fn And .Offset(, 3) = find_ln Then
                        'match
                        'do stuff
                       
                    End If
                End With
                Set FoundCell = SearchRange.FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
            Loop While firstaddress <> FoundCell.Address
           
        Else
            MsgBox "THE SELECTION DOES Not MATCH THE DATABASE!" & vbNewLine & vbNewLine & _
                   "Please either add a New a client Or choose a valid client details from the list.", _
                   16, "Record Not Found"
        End If
    End If
   
End Sub

Dave
Hi Dave,

I didn't think there would be too much of a change, but no you're right I should have posted a new question which I'll do now.
Thanks though for all your assistance, as a newbie you've helped me to bring some of my ideas to light, I do appreciate it :) Thanks again
 
Upvote 0

Forum statistics

Threads
1,214,515
Messages
6,119,970
Members
448,933
Latest member
Bluedbw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top