Multiple columns to populate data on userform based on header in combobox

abdo meghari

Well-known Member
Joined
Aug 3, 2021
Messages
612
Office Version
  1. 2019
Hi,
I search for code to populate data on form based on combo box , but my project will be more More expansive
here is what I got it so far wit I try populate items in combobox1 for sheets names and combobox2 for headers should search for it .
VBA Code:
Option Explicit
Dim a As Variant

Private Sub UserForm_Activate()
Dim ws As Variant
For Each ws In Sheets(Array("SV", "SR", "VS", "RS"))
ComboBox1.AddItem ws.Name
Next ws
Dim arr As Variant
Dim sh As Worksheet
Set sh = Sheets("SV")
For Each arr In Array("CUSTOMER", "INV.NO", "BRAND", "QTY", "PRICE", "TOTAL")
ComboBox2.AddItem arr
Next arr
 a = Sheets(ComboBox1).Range("A2:H" & Sheets("ComboBox1").Range("D" & Rows.Count).End(3).Row).Value
End Sub



Private Sub TextBox3_Change()
  Call FilterData
End Sub



Sub FilterData()
  Dim txt1 As String, txt2 As String, txt3 As String
  Dim i As Long, j As Long, k As Long
  
  ListBox1.Clear
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a)
    If TextBox3 = "" Then txt1 = a(i, 4) Else txt1 = TextBox3
    If LCase(a(i, 4)) Like LCase(txt1) Then
      k = k + 1
      For j = 1 To 8
        b(k, j) = a(i, j)
      Next
    End If
  Next
  If k > 0 Then ListBox1.List = b
End Sub

here is data in four sheets.
COL.xlsm
ABCDEFGH
1ITEMDATECUSTOMERINV.NOBRANDQTYPRICETOTAL
2115/06/2023CCF-1000BSTR_23448BS 750R16 R230 JAP4.00500.002,000.00
3215/06/2023CCF-1000BSTR_23448BS 700R16 R230 JAP2.00400.00800.00
4SUM2,800.00
5115/09/2023CCF-1001BSTR_23449GO 1200R20 AZ0026 CHI1.00920.00920.00
6215/09/2023CCF-1001BSTR_23449GO 1200R20 AZ183 CHI2.001,000.002,000.00
7SUM2,920.00
8115/09/2023CCF-1000BSTR_23450BS 1200R20 G580 JAP10.001,800.0018,000.00
9215/09/2023CCF-1000BSTR_23450BS 1200R20 R187 JAP10.001,800.0018,000.00
10315/09/2023CCF-1000BSTR_23450BS 1200R20 G580 THI10.001,800.0018,000.00
11SUM54,000.00
12116/09/2023CCF-1002BSTR_23451BS 215/60R16 ER30 JAP4.00400.001,600.00
13SUM1,600.00
14116/09/2023CCF-1001BSTR_23452BS 1200R20 G580 JAP5.001,800.009,000.00
15SUM9,000.00
16116/09/2023CCF-1001BSTR_23453BS 1200R20 G580 THI5.001,880.009,400.00
17SUM9,400.00
SV



COL.xlsm
ABCDEFGH
1ITEMDATECUSTOMERINV.NOBRANDQTYPRICETOTAL
2110/06/2023CCF-1002BSJ_23444BS 215/60R16 ER30 JAP4.00430.001,720.00
3SUM1,720.00
4110/06/2023CCF-1002BSJ_23445GO 1200R20 AZX0026 CHI2.00955.001,910.00
5SUM1,910.00
6115/09/2023CCF-1001BSJ_23446GO 1200R20 AZX0026 CHI2.00950.001,900.00
7215/09/2023CCF-1001BSJ_23446GO 1200R21 AZ0027 CHI3.001,000.003,000.00
8SUM4,900.00
9115/09/2023CCF-1000BSJ_23447BS 1200R20 G580 JAP1.002,000.002,000.00
10215/09/2023CCF-1000BSJ_23447BS 1200R20 G580 THI1.002,000.002,000.00
11315/09/2023CCF-1000BSJ_23447BS 1200R20 R187 JAP1.002,000.002,000.00
12SUM6,000.00
SR



COL.xlsm
ABCDEFGH
1ITEMDATECUSTOMERINV.NOBRANDQTYPRICETOTAL
2115/06/2023CCF-1000VSTR_23444BS 750R16 R230 JAP1.00500.00500.00
3SUM500.00
4115/09/2023CCF-1000VSTR_23445GO 1200R20 AZ01831.001,000.001,000.00
5SUM1,000.00
6115/09/2023CCF-1001VSTR_23446BS 1200R20 G580 JAP1.001,800.001,800.00
7215/09/2023CCF-1001VSTR_23446BS 1200R20 G580 JAP1.001,800.001,800.00
8SUM3,600.00
9116/09/2023CCF-1001VSTR_23447BS 215/60R16 ER30 JAP4.00400.001,600.00
10SUM1,600.00
11116/09/2023CCF-1001VSTR_23448BS 1200R20 R187 JAP1.001,800.001,800.00
12SUM1,800.00
13116/09/2023CCF-1000VSTR_23449BS 1200R20 G580 THI2.001,880.003,760.00
14SUM3,760.00
VS


COL.xlsm
ABCDEFGH
1ITEMDATECUSTOMERINV.NOBRANDQTYPRICETOTAL
2110/06/2023CCF-1002RSS_23222BS 215/60R16 ER302.00430.00860.00
3SUM860.00
4110/06/2023CCF-1001BSJ_23445GO 1200R20 AZ00261.00955.00955.00
5SUM955.00
6115/09/2023CCF-1002BSJ_23446GO 1200R20 AZ00261.00950.00950.00
7215/09/2023CCF-1002BSJ_23446GO 1200R21 AZ00272.001,000.002,000.00
8SUM2,950.00
RS



when I select sheet name from combobox1, select the header from combobox2 and write the ID is relating with the header in textbox3 then will populate data in listbox and sum colulmn QTY in textbox4 and sum column TOTAL in textbox5 like this
example SV sheets
P1.PNG
P2.PNG



P3.PNG



P4.PNG


P5.PNG



P6.PNG



when just select header and ID without sheet name will add column sheets names in third column in listbox
P7.PNG


as to dates(textbox1,textbox2) should be when select sheet name and header or when just select header without sheet name .
I hope correct my error and improve based on my requirements.
thanks
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Let's try an advanced filter approach.

Create a sheet and call it "Temp".
On that sheet put the following structure, including the formulas:
Dante Amor
ABCDEFGHIJKLMNOPQRS
1ITEMDATESHEET NAMECUSTOMERINV.NOBRANDQTYPRICETOTALSHEET NAMEDATEDATECUSTOMERINV.NOBRANDQTYPRICETOTAL
2>=0<=01.00
3
400/01/190000/01/1900
5
6ITEMDATESHEET NAMECUSTOMERINV.NOBRANDQTYPRICETOTAL
Temp
Cell Formulas
RangeFormula
L2L2=">="&MAX(L3:L4)
M2M2="<="&MIN(M3:M4)
L4L4=MIN(B:B)
M4M4=MAX(B:B)


but my project will be more More expansive
Wow it is. The project is ambitious and has a large number of combinations to filter, and with several specifications in each filter. That is why the advanced filter approach and hence the need for an auxiliary sheet.

✅ when I select sheet name from combobox1, select the header from combobox2 and write the ID is relating with the header in textbox3 then will populate data in listbox
✅sum colulmn QTY in textbox4 and sum column TOTAL in textbox5
✅when just select header and ID without sheet name will add column sheets names in third column in listbox
✅as to dates(textbox1,textbox2) should be when select sheet name and header or when just select header without sheet name
This date option is improved, you can even filter by just one date, FROM DATE and it automatically takes up to the last date.​
Or TO DATE and it automatically takes from the first date.​
Filter by dates without selecting any field or with the combination of one or more or all fields.​
Which seems wonderful to me and that is achieved in an easier way with the advanced filter.​

Notes:
  • Obviously I improved the charging of the comboboxes.
  • I did a test with 8 thousand records on each sheet and the response time is one second.
  • The textbox3 works until you capture a complete value that exists
  • In textbox3 the thousands separator format is not necessary, that is, you can put 1800 instead of 1,800.00

Put all code in your userform:
VBA Code:
Dim sht As Worksheet
Const frm As String = "#,##0.00;-#,##0.00;0.00"

Sub FilterData()
  Dim lr As Long
  Dim qty As Double, tot As Double

  Application.ScreenUpdating = False
 
  Call List_initial
  sht.Range("K2, L3:M3, N2:S2").ClearContents
  If ComboBox1.ListIndex > -1 Then
    sht.Range("K2").Value = ComboBox1.Value
    ListBox1.ColumnWidths = ";;0"
  Else
    sht.Range("K2").Value = ""
    ListBox1.ColumnWidths = ""
  End If
  If IsDate(TextBox1.Value) Then sht.Range("L3").Value = CDate(TextBox1.Value)
  If IsDate(TextBox2.Value) Then sht.Range("M3").Value = CDate(TextBox2.Value)
  If ComboBox2.ListIndex > -1 Then sht.Cells(2, Columns("N").Column + ComboBox2.ListIndex).Value = TextBox3.Value
    
  sht.Range("A1", sht.Range("I" & Rows.Count).End(3)).AdvancedFilter 2, sht.Range("J1:R2"), sht.Range("K6:S6"), False
 
  lr = sht.Range("K" & Rows.Count).End(3).Row
  If lr > 6 Then
    With sht.Range("K7:S" & lr)
      .Cells(1).Value = 1
      .Columns(1).DataSeries xlColumns, xlLinear, xlDay, 1, Trend:=False
      ListBox1.RowSource = sht.Range("K7:S" & lr).Address(external:=True)

      TextBox4.Value = Format(WorksheetFunction.Sum(.Columns(7)), frm)
      TextBox5.Value = Format(WorksheetFunction.Sum(.Columns(9)), frm)
    End With
  End If
  Application.ScreenUpdating = False
End Sub

Private Sub ComboBox1_Change()
  Call FilterData
End Sub
Private Sub ComboBox2_Change()
  TextBox3.Value = ""
End Sub
Private Sub TextBox1_Change()
  Call List_initial
  If checkDate(TextBox1) Then Call FilterData
End Sub
Private Sub TextBox2_Change()
  Call List_initial
  If checkDate(TextBox2) Then Call FilterData
End Sub
Private Sub TextBox3_Change()
  Dim f As Range
  Dim vValue As Variant
 
  Call List_initial
 
  If TextBox3.Value = "" Then
    Call FilterData
    Exit Sub
  End If
  If ComboBox2.ListIndex > -1 Then
    vValue = IIf(IsNumeric(TextBox3.Value), Val(TextBox3.Value), TextBox3.Value)
    Set f = sht.Columns(ComboBox2.ListIndex + 4).Find(vValue, , xlFormulas, xlWhole, , , False)
    If Not f Is Nothing Then
      Call FilterData
    End If
  End If
End Sub

Function checkDate(tBox As MSForms.TextBox)
  With tBox
    checkDate = True
    If .Value = "" Then Exit Function
    If Len(.Value) <> 10 Or Not IsDate(.Value) Or Not .Value Like "??/??/????" Then checkDate = False
  End With
End Function

Sub List_initial()
  sht.Range("K7:S" & Rows.Count).ClearContents
  TextBox4.Value = ""
  TextBox5.Value = ""
End Sub

Private Sub UserForm_Activate()
  Dim arr As Variant, itm As Variant, a As Variant
  Dim i As Long, j As Long, k As Long
 
  Set sht = Sheets("Temp")
  sht.Range("A2:I" & Rows.Count).ClearContents
  sht.Range("K2, L3:M3, N2:S2").ClearContents
  sht.Range("K7:S" & Rows.Count).ClearContents
  sht.Range("G:I").NumberFormat = frm
  sht.Range("B:B").NumberFormat = "dd/mm/yyyy"

  ComboBox1.List = Array("SV", "SR", "VS", "RS")
  ComboBox2.List = Array("CUSTOMER", "INV.NO", "BRAND", "QTY", "PRICE", "TOTAL")
 
  For Each itm In ComboBox1.List
    a = Sheets(itm).Range("A2", Sheets(itm).Range("H" & Rows.Count).End(3)).Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
      k = 0
    For i = 1 To UBound(a, 1)
      If a(i, 1) <> "SUM" Then
        k = k + 1
          b(k, 1) = a(i, 1)
          b(k, 2) = a(i, 2)
          b(k, 3) = itm
          b(k, 4) = a(i, 3)
          b(k, 5) = a(i, 4)
          b(k, 6) = a(i, 5)
          b(k, 7) = a(i, 6)
          b(k, 8) = a(i, 7)
          b(k, 9) = a(i, 8)
      End If
    Next
    sht.Range("A" & Rows.Count).End(3)(2).Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Next

  With ListBox1
    .RowSource = ""
    .ColumnCount = 8
    .ColumnHeads = True
  End With
 
  Call FilterData
End Sub

😇
 
Last edited:
Upvote 0
Really excellent !!😊
I have some notes:
1- I think should be 9 columns , not 8 columns in this line
Rich (BB code):
<span>With</span> ListBox1<br>    <span>.</span>RowSource <span>=</span> <span>""</span><br>    <span>.</span>ColumnCount <span>=</span> <span>8</span>
because will not show TOTAL column in list box.
2-I try changing ColumnWidths in listbox by add this line
VBA Code:
.ColumnWidths = "70;70;70;70;70;100;70;70;70"
but unfortunately doesn't change anything because there is wide space among columns.
  • The textbox3 works until you capture a complete value that exists
3- could search for part of value when I write until finishing or could this way effect for running speed?
 
Upvote 0
1- I think should be 9 columns , not 8 columns in this line
OK
Rich (BB code):
  With ListBox1
    .RowSource = ""
    .ColumnCount = 9
    .ColumnHeads = True
  End With


2. I try changing ColumnWidths in listbox by add this line
Rich (BB code):
  Call List_initial
  sht.Range("K2, L3:M3, N2:S2").ClearContents
  If ComboBox1.ListIndex > -1 Then
    sht.Range("K2").Value = ComboBox1.Value
    ListBox1.ColumnWidths = "70;70;0;70;70;100;70;70;70"    'to hide column sheet name
  Else
    sht.Range("K2").Value = "70;70;70;70;70;100;70;70;70"
    ListBox1.ColumnWidths = ""
  End If

3. could search for part of value when I write until finishing or could this way effect for running speed?
Does it actually work using ? or/and * as a wildcard, but only in the text fields (customer, inv, brand), examples:

At the beginning:
1730039396408.png

Both:
1730039515255.png

In the end:
1730039686587.png

If you also want it to work with numbers, I put the adjusted code:

VBA Code:
Option Explicit

Dim sht As Worksheet
Const frm As String = "#,##0.00;-#,##0.00;0.00"

Sub FilterData()
  Dim lr As Long
  Dim qty As Double, tot As Double

  Application.ScreenUpdating = False
 
  Call List_initial
  sht.Range("K2, L3:M3, N2:S2").ClearContents
  If ComboBox1.ListIndex > -1 Then
    sht.Range("K2").Value = ComboBox1.Value
    ListBox1.ColumnWidths = "70;70;0;70;70;100;70;70;70"
  Else
    sht.Range("K2").Value = ""
    ListBox1.ColumnWidths = "70;70;70;70;70;100;70;70;70"
  End If
  If IsDate(TextBox1.Value) Then sht.Range("L3").Value = CDate(TextBox1.Value)
  If IsDate(TextBox2.Value) Then sht.Range("M3").Value = CDate(TextBox2.Value)
  If ComboBox2.ListIndex > -1 Then
    On Error Resume Next
    sht.Cells(2, Columns("N").Column + ComboBox2.ListIndex).Value = TextBox3.Text
    On Error GoTo 0
  End If
 
  sht.Range("A1", sht.Range("I" & Rows.Count).End(3)).AdvancedFilter 2, sht.Range("K1:S2"), sht.Range("K6:S6"), False
 
  lr = sht.Range("K" & Rows.Count).End(3).Row
  If lr > 6 Then
    With sht.Range("K7:S" & lr)
      .Cells(1).Value = 1
      .Columns(1).DataSeries xlColumns, xlLinear, xlDay, 1, Trend:=False
      ListBox1.RowSource = sht.Range("K7:S" & lr).Address(external:=True)

      TextBox4.Value = Format(WorksheetFunction.Sum(.Columns(7)), frm)
      TextBox5.Value = Format(WorksheetFunction.Sum(.Columns(9)), frm)
    End With
  End If
  Application.ScreenUpdating = False
End Sub

Private Sub ComboBox1_Change()
  Call FilterData
End Sub
Private Sub ComboBox2_Change()
  TextBox3.Value = ""
End Sub
Private Sub TextBox1_Change()
  Call List_initial
  If checkDate(TextBox1) Then Call FilterData
End Sub
Private Sub TextBox2_Change()
  Call List_initial
  If checkDate(TextBox2) Then Call FilterData
End Sub
Private Sub TextBox3_Change()
  Dim f As Range
  Dim vValue As Variant
 
  Call List_initial
 
  If TextBox3.Value = "" Then
    Call FilterData
    Exit Sub
  End If
  If ComboBox2.ListIndex > -1 Then
    'vValue = IIf(IsNumeric(TextBox3.Value), Val(TextBox3.Value), TextBox3.Value)
    'Set f = sht.Columns(ComboBox2.ListIndex + 4).Find(vValue, , xlFormulas, xlWhole, , , False)
    'If Not f Is Nothing Then
      Call FilterData
    'End If
  End If
End Sub

Function checkDate(tBox As MSForms.TextBox)
  With tBox
    checkDate = True
    If .Value = "" Then Exit Function
    If Len(.Value) <> 10 Or Not IsDate(.Value) Or Not .Value Like "??/??/????" Then checkDate = False
  End With
End Function

Sub List_initial()
  sht.Range("K7:S" & Rows.Count).ClearContents
  TextBox4.Value = ""
  TextBox5.Value = ""
End Sub

Private Sub UserForm_Activate()
  Dim arr As Variant, itm As Variant, a As Variant
  Dim i As Long, j As Long, k As Long
 
  Set sht = Sheets("Temp")
  sht.Range("A2:I" & Rows.Count).ClearContents
  sht.Range("K2, L3:M3, N2:S2").ClearContents
  sht.Range("K7:S" & Rows.Count).ClearContents
  sht.Range("G:I").NumberFormat = frm
  sht.Range("B:B").NumberFormat = "dd/mm/yyyy"

  ComboBox1.List = Array("SV", "SR", "VS", "RS")
  ComboBox2.List = Array("CUSTOMER", "INV.NO", "BRAND", "QTY", "PRICE", "TOTAL")
 
  For Each itm In ComboBox1.List
    a = Sheets(itm).Range("A2", Sheets(itm).Range("H" & Rows.Count).End(3)).Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
      k = 0
    For i = 1 To UBound(a, 1)
      If a(i, 1) <> "SUM" Then
        k = k + 1
          b(k, 1) = a(i, 1)
          b(k, 2) = a(i, 2)
          b(k, 3) = itm
          b(k, 4) = a(i, 3)
          b(k, 5) = a(i, 4)
          b(k, 6) = a(i, 5)
          b(k, 7) = a(i, 6)
          b(k, 8) = a(i, 7)
          b(k, 9) = a(i, 8)
      End If
    Next
    sht.Range("A" & Rows.Count).End(3)(2).Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Next

  With ListBox1
    .RowSource = ""
    .ColumnCount = 9
    .ColumnHeads = True
  End With
 
  Call FilterData
End Sub

But for it to work with numbers you will have to put formulas, examples:

To QTY, you can put 5 or =">=5"
1730039979603.png


PRICE: ="<500"
1730040304175.png

TOTAL: =">9000"
1730040843171.png

The search in numerical values could also be partial, but it implies more changes and I consider that with that you have enough tools. ;)

Regards
😇
 
Upvote 0
Solution

Forum statistics

Threads
1,223,884
Messages
6,175,173
Members
452,615
Latest member
bogeys2birdies

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