VBA code With multiple criteria and multiple results in userform.

[KestutisTower]

Hello everyone. Im new to this forum. AND i'm stuck

I'm creating a userform with two comboboxes ant a textbox. the idea is to retrieve information from a table with data populated via other userform and date is autogenerated.

Customer:​	Product:​	Date:​
JOHN	TV	22/05/01
LINDA	TV	22/05/01
JOHN	RADIO	22/05/02
LINDA	PC	22/05/02
SUSIE	PC	22/05/01
JOHN	PC	22/05/01

Combobox1 rowsource is colum "Customer" and Combobox2 rowsource is "Date". What I need to do, is when I input selection in Combobox1 and Combobox2, data to appear in textbox1. As you can see, there are multiple results in some cases. So ... basically I need a VBA code with multiple criteria, to gel multiple results and to show all that in textbox1.

Hope I presented my problem clearly.
All help will be appreciated

 

[DanteAmor]

Hi and welcome to MrExcel!

Do the following:
- Put all of the following code on your form.
- If you use the Rowsource property to load comboboxes, remove it, as the following code loads both combos.
- I suggest that instead of a TextBox, the results appear in a ListBox, then create a ListBox in your form.
- Change in the code "Sheet1" to the name of the sheet that contains the data.

Dim a As Variant      'At the beginning of all the code.

Private Sub ComboBox1_Change()
  Call FilterData
End Sub

Private Sub ComboBox2_Change()
  Call FilterData
End Sub

Sub FilterData()
  Dim cmb1 As Variant, cmb2 As Variant
  Dim i As Long
  
  ListBox1.Clear
  For i = 1 To UBound(a)
    If ComboBox1.Value = "" Then cmb1 = a(i, 1) Else cmb1 = ComboBox1.Value
    If ComboBox2.Value = "" Then cmb2 = a(i, 3) Else cmb2 = ComboBox2.Value
    If a(i, 1) = cmb1 And a(i, 3) = CDate(cmb2) Then
      ListBox1.AddItem a(i, 2)
    End If
  Next
End Sub

Private Sub UserForm_Activate()
  Dim sh As Worksheet
  Dim dic1 As Object, dic2 As Object
  Dim i As Long
  
  Set sh = Sheets("Sheet1")     'Adjust to the name of your sheet.
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  dic1.comparemode = vbTextCompare
  a = sh.Range("A2", sh.Range("C" & Rows.Count).End(3)).Value
  
  'To load data into combos 1 and 2
  For i = 1 To UBound(a)
    dic1(a(i, 1)) = Empty
    dic2(a(i, 3)) = Empty
  Next
  ComboBox1.List = Application.Transpose(dic1.keys)
  ComboBox2.List = Application.Transpose(dic2.keys)
End Sub

 

[KestutisTower]

Thanks DanteAmor!!

Your code worked perfectly!
I have made a sample table and it did just what it had to, but I'm having problem with adopting it to my working document. I'll try to include
a minisheat this time.

multipage (version 1).xlsb
	A	B	C	D	E	F	G	H	I	J	K
1	Pirkėjas	Prekė	Kiekis	Komentaras	Bendra kaina	Vieneto kaina	LT kaina	Pelnas	Rita/Loreta	Pilnas	Data
2	kestas	maike	1	xxl	5	5			R	maike 1 vnt. xxl -	10/6/2022
3	lina	lankelis	2	zalias ir melynas	14	7			L	lankelis 2 vnt. zalias ir melynas -	10/6/2022
4	Rita	kelnes	1	XL baltos	10	10			L	kelnes 1 vnt. XL baltos -	10/6/2022
Pardavimai

Cell Formulas
Range	Formula
E2:E4	E2	=[Vieneto kaina]*[Kiekis]
I2:I4	I2	=VLOOKUP([Prekė],Eiliskumas!$C$4:$E$100,3,FALSE)

Also uploading picture off the userform and the code.

This code is in module1 :

Sub Reset()

  Dim iRow As Long
  iRow = [Counta(Pardavimai!A:A)] 'identify last row

  With UserForm1
    
    .txtVardas.Value = ""
    .txtPrekesNr.Value = ""
    .txtKiekis.Value = ""
    .txtKomentaras.Value = ""
    .txtPreke.Value = ""
    .txtVienetoKaina.Value = ""
    
    .lstInformacija.ColumnCount = 6
    .lstInformacija.ColumnHeads = True
    .lstInformacija.ColumnWidths = "60,60,60,60,60,60"
    
   If iRow > 1 Then
       
       .lstInformacija.RowSource = "Pardavimai!A2:F" & iRow
       
   Else
       
       .lstInformacija.RowSource = "Pardavimai!A2:F2"
       
   End If
   
  End With

End Sub


Sub Submit()

   Dim sh As Worksheet
   Dim iRow As Long
   
   Set sh = ThisWorkbook.Sheets("Pardavimai")
   iRow = [Counta(Pardavimai!A:A)] + 1
   
   With sh
       
       .Cells(iRow, 1) = UserForm1.txtVardas.Value
       
       .Cells(iRow, 10) = UserForm1.txtPreke.Value & "   " & UserForm1.txtKiekis.Value & " vnt." & "   " & UserForm1.txtKomentaras.Value & " - "
       
       .Cells(iRow, 11) = [Text(Now(), "DD-MM-YYYY")]
       
       .Cells(iRow, 2) = UserForm1.txtPreke.Value
       
       .Cells(iRow, 3) = UserForm1.txtKiekis.Value
       
       .Cells(iRow, 4) = UserForm1.txtKomentaras.Value
       
       .Cells(iRow, 6) = UserForm1.txtVienetoKaina.Value
              
   End With
    
End Sub

Sub show_UserForm1()


  UserForm1.Show False
  


End Sub

And this one is in userform itself.

Private Sub cmdIstrinti_Click()

  Call Reset
  

End Sub

Private Sub cmdOK_Click()

  Call Submit
  Call Reset
  

End Sub





Private Sub UserForm_Initialize()

 Call Reset
  
End Sub

Private Sub txtPrekesNr_Change()

   If txtPrekesNr.Value = "" Then
      txtPreke.Value = ""
   End If
   
   If IsNumeric(txtPrekesNr.Value) Then
   txtPreke.Value = WorksheetFunction.VLookup(CLng(txtPrekesNr.Value), Sheets("Eiliskumas").Range("B4:D100"), 2, False)
   txtVienetoKaina.Value = WorksheetFunction.VLookup(CLng(txtPrekesNr.Value), Sheets("Eiliskumas").Range("B4:D100"), 3, False)
   End If

End Sub

This code is to populate datasheat.


What I need is combobox1 to be populated with names from colum A, combobox2 with dates from colum K, and listbox1 to populate with data from colum J.

Thanks you for such a quick answer

 

[DanteAmor]

.lstInformacija.ColumnHeads = True
.lstInformacija.ColumnWidths = "60,60,60,60,60,60"
.lstInformacija.RowSource = "Pardavimai!A2:F" & iRow

If you want the headers to be displayed, then I have to change the structure of my code for when you perform a filter. The way I know is to copy the filtered records to a Temporary sheet, then upload the records to the listbox with the RowSource property.

The code I used is to load the listbox with the List property, but that way you can't load the sheet headers.

If you want it with headers, I have to do all the code. Give me a chance and I do it in the day and I show it to you so you can try it.

 

[KestutisTower]

If you want the headers to be displayed, then I have to change the structure of my code for when you perform a filter. The way I know is to copy the filtered records to a Temporary sheet, then upload the records to the listbox with the RowSource property.

The code I used is to load the listbox with the List property, but that way you can't load the sheet headers.

If you want it with headers, I have to do all the code. Give me a chance and I do it in the day and I show it to you so you can try it.

I'm afraid I have confused you with all that info the code populates sheet named "Pardavimai" and also shows in other ListBox.
My userform has two pages.
This is page 1

The code is populating sheet ("Pirkimai") via text boxes and also displays info in listbox (which is named "lstInformacija").
This is second page.

and I need the source of top combobox ("combobox1") to be values in column A, source of lower combobox ("combobox2") to be dates from column K. ant I need to retrieve values to listbox below.
I have tried to copy your code to UserForm1. but it brings "runtime error 380".

 

[DanteAmor]

I am very confused, do you want me to modify my code?
Why did you put your code?

 

[KestutisTower]

I'm sorry for confusion DanteAmor .My code is to populete datasheet, when purchase is made. I need a way to retrieve summarised data afterwards. For this I want to use page 2 in the userform . As you probably can tell, I'm new to Excel, especially in VBA coding. The other code I have coped from internet and adjusted for my needs. So, if there is another way to populate datasheet with page1 and to summarise with page 2, I do not know it.

If you could spare some time to fix this, it would be wonderfull Dante

 

[DanteAmor]

I think I'm already understanding, you need 2 codes, one to pass data from the userform to the sheet (Page 1). And the other to pass data from the sheet to the userform (Page 2).

I help you with the second, is the subject of this thread.

But then back to post #4, do you want headers? And I guess you still require the data to be uploaded to the listbox with the criteria of combo1 and combo2?

 

[KestutisTower]

Yes Dante you got my idea

No, I don't need headers, and yes to double criteria.
Thank you so much!

 

[DanteAmor]

ok

Dim a As Variant      'At the beginning of all the code.

Private Sub ComboBox1_Change()
  Call FilterData
End Sub

Private Sub ComboBox2_Change()
  Call FilterData
End Sub

Sub FilterData()
  Dim cmb1 As Variant, cmb2 As Variant
  Dim i As Long
  
  ListBox1.Clear
  For i = 1 To UBound(a)
    If ComboBox1.Value = "" Then cmb1 = a(i, 1) Else cmb1 = ComboBox1.Value   '1 = column A - names
    If ComboBox2.Value = "" Then cmb2 = a(i, 11) Else cmb2 = ComboBox2.Value  '11 = column K - dates
    If a(i, 1) = cmb1 And a(i, 11) = CDate(cmb2) Then                         '1 = A, 11 = K
      ListBox1.AddItem a(i, 10)                                               '10 = J
    End If
  Next
End Sub

Private Sub UserForm_Activate()
  Dim sh As Worksheet
  Dim dic1 As Object, dic2 As Object
  Dim i As Long
  
  Set sh = Sheets("Pardavimai")     'Adjust to the name of your sheet.
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  dic1.comparemode = vbTextCompare
  a = sh.Range("A2:K" & sh.Range("J" & Rows.Count).End(3).Row).Value
  
  'To load data into combos 1 and 2
  For i = 1 To UBound(a)
    dic1(a(i, 1)) = Empty       '1 = column A - names
    dic2(a(i, 11)) = Empty      '11 = column K - dates
  Next
  ComboBox1.List = Application.Transpose(dic1.keys)
  ComboBox2.List = Application.Transpose(dic2.keys)
End Sub