List box data based on combobox value vba

[waheed254]

I have data as given sample,
Now what i am trying is a Userform with ComboBox for Selecting Date from 1st Column, and a List Box Value Contaning Same 3 Columns But Only Data matching Combobox Value.

DATE	NAME	VALUE
21-12-2017	A	1
21-12-2017	B	2
22-12-2017	C	3
23-12-2017	D	4

<tbody>
</tbody>

Result in Listbox Should be if in ComboBox1 Date 21-12-2017 is Selected.

21-12-2017	A	1
21-12-2017	B	2

<tbody>
</tbody>

Thnx in Advance.

 

[ExcelRytis]

Hi Waheed,

I have done a similar UserForm, using the below link:

http://www.onlinepclearning.com/excel-vba-calculations-in-a-userform/

See if this helps, advise how you get on, please. I've managed to make it work for me.

Good luck

 

[waheed254]

Dear, I have Multiple Rows & Columns of Data given is a very smaller version of Sample Data which will be retrieved, in Single List Box.
I need Many Columns and Rows data in result, TextBox won't Work.

Hi Waheed,

I have done a similar UserForm, using the below link:

http://www.onlinepclearning.com/excel-vba-calculations-in-a-userform/

See if this helps, advise how you get on, please. I've managed to make it work for me.

Good luck

 

[MickG]

Try this code in your Userform.
NB:= Paste this code in your Userform module, the Userform should have a"Listbox1" and a "Combobox1" in it.
NB:- When you know your Listbox1 columns widths, set the Individual column widths in the Combobox1 code.

Option Explicit
[COLOR=navy]Dim[/COLOR] Dic [COLOR=navy]As[/COLOR] Object
Private [COLOR=navy]Sub[/COLOR] ComboBox1_Change()
[COLOR=navy]With[/COLOR] ListBox1
    .Clear
    .ColumnCount = ActiveSheet.Cells(1).CurrentRegion.Columns.Count
   '[COLOR=green][B] .ColumnWidths = "50,20,20"[/B][/COLOR]
    .List = Dic(CDate(ComboBox1.Value))(0)
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]




Private [COLOR=navy]Sub[/COLOR] UserForm_Initialize()
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Q [COLOR=navy]As[/COLOR] Variant, Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Ray = ActiveSheet.Cells(1).CurrentRegion
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] n = 2 To Rng.Count
    
    [COLOR=navy]If[/COLOR] Not Dic.Exists(CDate(Ray(n, 1))) [COLOR=navy]Then[/COLOR]
        ReDim nRay(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
        
        [COLOR=navy]For[/COLOR] ac = 1 To UBound(Ray, 2)
            [COLOR=navy]If[/COLOR] ac = 1 [COLOR=navy]Then[/COLOR]
                nRay(1, ac) = Format(Ray(n, ac), "dd/mm/yyyy")
            [COLOR=navy]Else[/COLOR]
                nRay(1, ac) = Ray(n, ac)
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] ac
        Dic.Add CDate(Ray(n, 1)), Array(nRay, 1)
    [COLOR=navy]Else[/COLOR]
        Q = Dic(CDate(Ray(n, 1)))
            Q(1) = Q(1) + 1
            [COLOR=navy]For[/COLOR] ac = 1 To UBound(Ray, 2)
                [COLOR=navy]If[/COLOR] ac = 1 [COLOR=navy]Then[/COLOR]
                     Q(0)(Q(1), ac) = Format(Ray(n, ac), "dd/mm/yyyy")
                [COLOR=navy]Else[/COLOR]
                     Q(0)(Q(1), ac) = Ray(n, ac)
                [COLOR=navy]End[/COLOR] If
            [COLOR=navy]Next[/COLOR] ac
        Dic(CDate(Ray(n, 1))) = Q
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n
[COLOR=navy]Dim[/COLOR] k
Me.ComboBox1.List = Application.Transpose(Dic.keys)
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[waheed254]

Thanks Brother, Worked as required, Can u help a little more.

Can i export Listbox Data to New Excel Sheet with Borders and Headers by Command Button.

 

[waheed254]

Export Done with Given code, Just One Issue, Headers are Missing in List Box, also when Exported & Same Formatting/Borders/Width/Height Required when Data is Copied to New File.



Private Sub CommandButton1_Click()
With Workbooks.Add
.Sheets(1).Range(Cells(1, 1), Cells(Me.ListBox1.ListCount, Me.ListBox1.ColumnCount)) = _
Me.ListBox1.List
Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
End With
End Sub

 

[MickG]

Try new "Initialize" event for Headers and "CommandButton1" code for Data transfer to new workbook.

Private [COLOR="Navy"]Sub[/COLOR] UserForm_Initialize()
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Ray = ActiveSheet.Cells(1).CurrentRegion
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 2 To Rng.Count
    
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(CDate(Ray(n, 1))) [COLOR="Navy"]Then[/COLOR]
        ReDim nRay(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
        
        [COLOR="Navy"]For[/COLOR] ac = 1 To UBound(Ray, 2)
            nRay(1, ac) = Ray(1, ac)
            [COLOR="Navy"]If[/COLOR] ac = 1 [COLOR="Navy"]Then[/COLOR]
                nRay(2, ac) = Format(Ray(n, ac), "dd/mm/yyyy")
            [COLOR="Navy"]Else[/COLOR]
                nRay(2, ac) = Ray(n, ac)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] ac
        Dic.Add CDate(Ray(n, 1)), Array(nRay, 2)
    [COLOR="Navy"]Else[/COLOR]
        Q = Dic(CDate(Ray(n, 1)))
            Q(1) = Q(1) + 1
            [COLOR="Navy"]For[/COLOR] ac = 1 To UBound(Ray, 2)
                [COLOR="Navy"]If[/COLOR] ac = 1 [COLOR="Navy"]Then[/COLOR]
                     Q(0)(Q(1), ac) = Format(Ray(n, ac), "dd/mm/yyyy")
                [COLOR="Navy"]Else[/COLOR]
                     Q(0)(Q(1), ac) = Ray(n, ac)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] ac
        Dic(CDate(Ray(n, 1))) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Dim[/COLOR] k
Me.ComboBox1.List = Application.Transpose(Dic.keys)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]





Private [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
[COLOR="Navy"]If[/COLOR] Me.ListBox1.ListCount > 0 [COLOR="Navy"]Then[/COLOR]
 [COLOR="Navy"]With[/COLOR] Workbooks.Add
    [COLOR="Navy"]With[/COLOR] .Sheets(1).Range(Cells(1, 1), Cells(Dic.Count, Me.ListBox1.ColumnCount))
        .Value = Me.ListBox1.List
        .Borders.Weight = 2
        .Columns.AutoFit
   [COLOR="Navy"]End[/COLOR] With
    Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
 [COLOR="Navy"]End[/COLOR] With
 [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[waheed254]

Thanks Brother worked Well after a little modification.

 

[MickG]

You're welcome