VBA to concatenate three columns and display in a single listbox or Combobox

[aaleem]

Hi,

Im trying to get the unique dates from a range, sorted them in ascending order converting dates into the financial year week (which is based on July to Jun year). Once this is done the result i would like to display in a listbox by concatenating the week number + Week Start Date + Week End date

i able to get to the last bit however the data display in list box is not in the above format.

any help and guidance will be much appreciated. There are two codes one for unique dates and the other one for listing the values in combobox.

Worksheet prompt_example.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Start Time (DD/MM/YYYY)					Start Time (DD/MM/YYYY)				Week start Date	Week End date	Week Number
2	24-05-21					24-05-21	Week start Date	Start Date	24-05-21	23-05-21	29-05-21	47
3	29-05-21					29-05-21				30-05-21	05-06-21	48
4	30-05-21					30-05-21				06-06-21	12-06-21	49
5	30-05-21					31-05-21				13-06-21	19-06-21	50
6	30-05-21					01-06-21				20-06-21	26-06-21	51
7	31-05-21					02-06-21				27-06-21	03-07-21	52
8	01-06-21					03-06-21				04-07-21	10-07-21	1
9	01-06-21					04-06-21				11-07-21	17-07-21	2
10	01-06-21					05-06-21				18-07-21	24-07-21	3
11	02-06-21					06-06-21				25-07-21	31-07-21	4
12	03-06-21					07-06-21				01-08-21	07-08-21	5
13	04-06-21					08-06-21				08-08-21	14-08-21	6
14	31-05-21					09-06-21				15-08-21	21-08-21	7
15	01-06-21					10-06-21				22-08-21	28-08-21	8		The desired result should be
16	02-06-21					11-06-21				29-08-21	04-09-21	9
17	03-06-21					12-06-21				05-09-21	11-09-21	10		WK-47-23-05-21 - 29-05-21
18	04-06-21					13-06-21				12-09-21	18-09-21	11
19	05-06-21					14-06-21				19-09-21	25-09-21	12
20	06-06-21					15-06-21				26-09-21	02-10-21	13
21	07-06-21					16-06-21				03-10-21	09-10-21	14
22	08-06-21					17-06-21				10-10-21	16-10-21	15
23	09-06-21					18-06-21				17-10-21	23-10-21	16
24	10-06-21					19-06-21				24-10-21	30-10-21	17
25	11-06-21					20-06-21				31-10-21	06-11-21	18
26	12-06-21					21-06-21				07-11-21	13-11-21	19
27	13-06-21					22-06-21				14-11-21	20-11-21	20
28	14-06-21					23-06-21				21-11-21	27-11-21	21
29	15-06-21					24-06-21				28-11-21	04-12-21	22
30	16-06-21					25-06-21				05-12-21	11-12-21	23
31	17-06-21					26-06-21				12-12-21	18-12-21	24
32	18-06-21					27-06-21				19-12-21	25-12-21	25
33	19-06-21					28-06-21				26-12-21	01-01-22	26
34	20-06-21					29-06-21				02-01-22	08-01-22	27
Sheet1

Cell Formulas
Range	Formula
I2	I2	=F2
J2	J2	=MIN(F:F)-WEEKDAY(I2,17)+1
K2:K34	K2	=IF(J2="","",J2+7-WEEKDAY(J2,17))
L2:L34	L2	=WEEKNUM(J2-184)
J3:J34	J3	=IF(MAX(F:F)>K2,K2+1,"")
A9:A10,A5:A6	A5	=A4
A16:A34,A11:A13,A7:A8	A7	=A6+1

Sub Uniques()
    Dim oColl       As New Collection
    
    Dim nr          As Variant
    Dim vArr1       As Long
    Dim vItem       As Variant
    Dim j           As Long
    
    Application.ScreenUpdating = False
    
    nr = Range("A" & Rows.Count).End(xlUp).Row
    vArr = Range("A1:A" & (nr))
    
    On Error Resume Next
    'For j = LBound(vArr) To UBound(vArr1)
    For j = 1 To nr
        
        oColl.Add vArr(j, 1), CStr(vArr(j, 1))
    Next j
    On Error GoTo 0
    
    For Each vItem In oColl
        X = X + 1
        Range("F" & X).Value = vItem
        Columns("F:F").Sort key1:=Range("F2"), _
                            order1:=xlAscending, Header:=xlYes
        'Debug.Print vItem
    Next vItem
    
    Call ListBox1
    Application.ScreenUpdating = True
End Sub

Sub ListBox1()
    
    Dim UnionRange          As Range
    Dim cell                As Range
    Dim lr As Variant

    Application.ScreenUpdating = False
    lr = Columns("j").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
    ' use Union to merge as many named ranges you need
    'Set UnionRange = Union(Range("Wk_Start"), Range("Wk_End"), Range("Wk_Num"))
    Set UnionRange = Union(Range("J1:J" & lr), Range("k1:K" & lr), Range("L1:L" & lr))
    
    Me.ComboBox1.Clear
    
    For Each cell In UnionRange
        ComboBox1.AddItem cell.Value
    Next cell
    ComboBox1.ListIndex = 0
    
    Range("g2").Value = Me.ComboBox1.Text
    Application.ScreenUpdating = True
End Sub