Data Validation List without duplicates

[dsubash]

Dear experts,

I have a database in Sheet 1, which contains the following fields
Col. A - List of Branches (Contains Duplicate Entries)
Col. B - List of Products (Contains Duplicate Entries) - certain products are unique to only certain branches while few products are available in all branches.
Col. C - Col. M - other details.

This sheet contains more than 10000 records containing the transactions for a particular month.

I need to prepare a report in Sheet 2 with the Branch and Product as criterias.
In Cell. A2, I have created a dropdown list for branches (after removing duplicates) and used Name Manager to create a Data Validation List.
I need the following in Cell B2 (Sheet 2)
a. A dropdown list of products from Col. B of Sheet 1
b. I need only the products list available against the branch selected in Cell A1 and should not display the products that are not available in the specific branch.
c. Duplicate product names to be removed and only unique names to be available in the dropdown list.
d. Option for autofill product names when one or more characters are typed.
e. Dropdown list should not contain blank entries
f. If possible Product names to be alphabetically displayed.

I tried to use Vlookup and for listing products against each branch in different columns, tried removing duplicates from this list in another column and using name manager for each branch. But since my list of branches and Products are more (20 + branches and 500 + products), I found it difficult to create multiple columns for vlookup and removing duplicates. Also had the problem of blanks in the drop down.

Is there any other options (VBA Code) to get what i want. I am using Office 2019 Professional and hence cannot use formulas avaialble in later versions (Sort / Unique, etc).

I tried viewing many threads in the forum, but was unable to find what i want. Threads available were mostly for higher versions of excel.

Thanks and regards
Subash D

 

[kvsrinivasamurthy]

Send original data of this result showing column names and row number.

 

[dsubash]

Send original data of this result showing column names and row number.

Sir, have uploaded the file with sample data for your reference.

Dropbox

www.dropbox.com

 

[kvsrinivasamurthy]

Here is the corrected macro code. No need of any change in the code for data in the file,. Number of rows of data no worry.. It is taken care of.

Sub GetBranchProductsList()
Dim A, M, T&, Ta&, K&
Dim Dic1 As Object
Application.ScreenUpdating = False
A = Sheets("Sheet1").Range("A1").CurrentRegion.Offset(1, 0).Resize(, 2)
Set Dic1 = CreateObject("Scripting.dictionary")
With Dic1
For T = 1 To UBound(A, 1) - 1
If .exists(A(T, 1)) Then
    If InStr(1, .Item(A(T, 1)), A(T, 2)) = 0 Then
    .Item(A(T, 1)) = .Item(A(T, 1)) & "_" & A(T, 2)
    End If
Else
.Item(A(T, 1)) = A(T, 2)
End If
Next T
K = .Count
End With

With Sheets("Sheet1").Range("O1")
.CurrentRegion.Offset(1, 0).Clear
.Value = "Branches"
.Offset(1, 0).Resize(K, 1) = WorksheetFunction.Transpose(Dic1.keys)
.Offset(0, 1).Resize(1, K) = Dic1.keys
For Ta = 0 To K - 1
M = Split(Dic1.Item(Dic1.keys()(Ta)), "_")   '
If UBound(M) >= 0 Then .Offset(1, Ta + 1).Resize(UBound(M) + 1, 1) = WorksheetFunction.Transpose(M)
M = ""
Next Ta
End With

Application.ScreenUpdating = True
End Sub

Worksheet event code is for Sheet2 not for Sheet1.
Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then Target.Offset(0, 1) = ""
End Sub

Referrer Due Statement - Dec 2025 - Sample - 03-01-2025.xlsm
	A	B	C	D	E	F	G	H	I	J
1		Firm_Name	Ref_Name
2		Karur	HOME COLLECTION
3
4
5
6	Sl. No	Firm_Name	Ref_Name	SID Date	SID No.	Gross_Amount	Discount	Paid_Amount	Due_Amount
7	1	Karur	HOME COLLECTION	04-12-2024	55994	100	0	100	0
8	2	Karur	HOME COLLECTION	04-12-2024	55994	100	0	100	0
9
10
Sheet2

Cell Formulas
Range	Formula
A7	A7	=IF(LEN(B7)>0,SUM(A6)+1,"")
B7:B10	B7	=IF(D7="","",$B$2)
C7:C10	C7	=IF(D7="","",$C$2)
D7:E10	D7	=IFERROR(INDEX(Sheet1!C$2:C$4710,AGGREGATE(15,6,ROW(Sheet1!$C$2:$C$4710)/(ISNUMBER(MATCH(Sheet1!$A$2:$A$4710,Sheet2!$B$2,0))*ISNUMBER(MATCH(Sheet1!$B$2:$B$4710,Sheet2!$C$2,0))),ROWS($C$7:$C7))-ROW($B$1)),"")
F7:G10	F7	=IFERROR(INDEX(Sheet1!G$2:G$4710,AGGREGATE(15,6,ROW(Sheet1!$C$2:$C$4710)/(ISNUMBER(MATCH(Sheet1!$A$2:$A$4710,Sheet2!$B$2,0))*ISNUMBER(MATCH(Sheet1!$B$2:$B$4710,Sheet2!$C$2,0))),ROWS($C$7:$C7))-ROW($B$1)),"")
H7:I10	H7	=IFERROR(INDEX(Sheet1!J$2:J$4710,AGGREGATE(15,6,ROW(Sheet1!$C$2:$C$4710)/(ISNUMBER(MATCH(Sheet1!$A$2:$A$4710,Sheet2!$B$2,0))*ISNUMBER(MATCH(Sheet1!$B$2:$B$4710,Sheet2!$C$2,0))),ROWS($C$7:$C7))-ROW($B$1)),"")
A8:A10	A8	=IF(LEN(D8)>0,SUM(A7)+1,"")
Press CTRL+SHIFT+ENTER to enter array formulas.

Cells with Data Validation
Cell	Allow	Criteria
B2	List	=OFFSET(Sheet1!$O$2,0,0,COUNTA(Sheet1!$O$2:$O$47))
C2	List	=OFFSET(Sheet1!$O$2,0,MATCH($B2,Sheet1!$P$1:$AF$1,0),COUNTA(INDEX(Sheet1!$P$2:$AF$1000,,MATCH($B2,Sheet1!$P$1:$AF$1,0))))

Sample of result in Sheet1. It extends for more columns actually.

Referrer Due Statement - Dec 2025 - Sample - 03-01-2025.xlsm
	O	P	Q	R	S
1	Branches	Pondicherry	Salem	Cuddalore	Neyveli
2	Pondicherry	JIPMER HOSPITALS	Self	RAMACHANDRA HOSPITAL	ARCHANA HOSPITAL
3	Salem			HOME COLLECTION	HOME COLLECTION
4	Cuddalore
5	Neyveli
6	Maduranthagam
7	Tindivanam
8	Chengalpet
9	Kallakurichi
10	Ilayangudi
11	Thiruvarur
12	South Street
13	Keelakarai
14	Chidambaram
15	Madurai
16	Trichy
17	Karur
18	Theppakulam
Sheet1

 

[kvsrinivasamurthy]

Worksheet event code for Sheet2:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$A$2" Then Target.Offset(0, 1) = ""
Application.EnableEvents = True
End Sub

 

[dsubash]

Worksheet event code for Sheet2:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$A$2" Then Target.Offset(0, 1) = ""
Application.EnableEvents = True
End Sub

Thanks Mr. Murthy,

Will check and revert back shortly

Regards
Subash D

 

[kvsrinivasamurthy]

I have modified macro code to incorporate sorting of Product list for each branch.

Sub GetBranchProductsList()
Dim A, M, T&, Ta&, K&
Dim Dic1 As Object
Application.ScreenUpdating = False
A = Sheets("Sheet 1").Range("A1").CurrentRegion.Offset(1, 0).Resize(, 2)
Set Dic1 = CreateObject("Scripting.dictionary")
With Dic1
For T = 1 To UBound(A, 1) - 1
If .exists(A(T, 1)) Then
.Item(A(T, 1)) = .Item(A(T, 1)) & "," & A(T, 2)
Else
.Item(A(T, 1)) = A(T, 2)
End If
Next T
K = .Count
End With

With Sheets("Sheet 1").Range("K1")
.CurrentRegion.Clear
.Value = "Branches"
.Offset(1, 0).Resize(K, 1) = WorksheetFunction.Transpose(Dic1.keys)
.Offset(0, 1).Resize(1, K) = Dic1.keys
For Ta = 0 To K - 1
M = Split(Dic1.Item(A(Ta + 1, 1)), ",")
If UBound(M) >= 0 Then .Offset(1, Ta + 1).Resize(UBound(M) + 1, 1) = WorksheetFunction.Transpose(M)
    If UBound(M) > 0 Then
    .Offset(1, Ta + 1).Resize(UBound(M) + 1, 1).Sort Key1:=.Offset(1, Ta + 1), Order1:=xlAscending, Header:=xlNo
    End If
M = ""
Next Ta
End With

Application.ScreenUpdating = True
End Sub