Extract Unique Values from Multiple Sheets

[ravi2628]

Hi Friends,

Good Morning, Afternoon, Evening, Night.

I required a VBA code or Formula to Extract the unique values from Multiple Sheets and I need to specify the column manually.

Input:
Sheet1:

Book1
	A	B	C
1	Country	Geography	Molecule description
2	Srilanka	Non Latam	Abiraterone Acetate Tablets 250 mg
3	Bhutan	Non Latam	Adenosine injection USP 6mg/2mL
4	Peru	Latam	Adenosine injection USP 6mg/2mL
5	Bhutan	Non Latam	Amphotericin B liposome injection 50mg
6	El Salvador	Latam	Amphotericin B liposome injection 50mg
7	Honduras	Latam	Amphotericin B liposome injection 50mg
8	Paraguay	Latam	Amphotericin B liposome injection 50mg
9	Peru	Latam	Amphotericin B liposome injection 50mg
10	Syria	Non Latam	Amphotericin B liposome injection 50mg
11	Guatemala	Latam	Anastrazole tablets IP 1mg
12	Honduras	Latam	Anastrazole tablets IP 1mg
13	Nepal	Non Latam	Anastrazole Tablets IP 1mg
14	Srilanka	Non Latam	Anastrazole tablets IP 1mg
15	Trinidad & Tobago	Latam	Anastrazole tablets IP 1mg
16	Bhutan	Non Latam	Atracurium Besylate injection 25mg
17	El Salvador	Latam	Bicalutamide Tablets USP 50mg
18	Guatemala	Latam	Bicalutamide Tablets USP 50mg
19	Honduras	Latam	Bicalutamide Tablets USP 50mg
20	Philippines	Non Latam	Bicalutamide Tablets USP 50mg
21	Dominican Republic	Latam	Bleomycin for Inj 15 units USP
22	DR Congo	Non Latam	Bleomycin for Inj 15 units USP
23	El Salvador	Latam	Bleomycin for Inj 15 units USP
24	Guatemala	Latam	Bleomycin for Inj 15 units USP
25	Honduras	Latam	Bleomycin for Inj 15 units USP
26	Nicaragua	Latam	Bleomycin for Inj 15 units USP
27	Syria	Non Latam	Bleomycin for Inj 15 units USP
28	Honduras	Latam	Bortezomib for injection 2mg
29	Nepal	Non Latam	Bortezomib for Injection 2mg
30	Srilanka	Non Latam	Bortezomib for injection 2mg
31	Chile	Latam	Bortezomib for injection 3.5 mg
32	Dominican Republic	Latam	Bortezomib for injection 3.5 mg
33	Guatemala	Latam	Bortezomib for injection 3.5 mg
34	Syria	Non Latam	Bortezomib for injection 3.5 mg
35	Trinidad & Tobago	Latam	Bortezomib for injection 3.5 mg
36	Nicaragua	Latam	Bupivacaine Hcl Injection 50mg/20ml
37	Philippines	Non Latam	Bupivacaine Hcl in Dextrose Inj 20mg
38	Peru	Latam	Bupivacaine Hcl injection 100mg/20ml
39	Jamaica	Latam	Busulfan Injection 60mg
40	Colombia	Latam	Busulfan Injection 60mg(VIAL)
41	Guatemala	Latam	Busulfan Injection 60mg(VIAL)
42	Honduras	Latam	Busulfan Injection 60mg(VIAL)
43	Iran	Non Latam	Busulfan Injection 60mg(VIAL)
44	Peru	Latam	Busulfan Injection 60mg(VIAL)
45	Syria	Non Latam	Busulfan Injection 60mg(VIAL)
46	Chile	Latam	Busulfan tablets 2mg
47	Guatemala	Latam	Busulfan tablets 2mg
48	Philippines	Non Latam	Busulfan tablets 2mg
49	DR Congo	Non Latam	Capecitabine tablets USP 500mg
Registration

Sheet2:

Book1
	A	B	C
1	Country	Geography	Molecule description
2	Ecuador	Latam	Fludarabine Phosphate for inj USP 50 mg
3	Georgia	Non Latam	Cyclophosphamide injection IP 200
4	Georgia	Non Latam	Cyclophosphamide injection IP 500
5	Georgia	Non Latam	Cyclophosphamide injection IP 1000
6	Georgia	Non Latam	Irinotecan Hcl Injection IP 40mg/2mL
7	Georgia	Non Latam	Irinotecan Hcl Injection IP 100mg/5mL
8	Georgia	Non Latam	Fludarabine Phosphate for inj USP 50 mg
9	Georgia	Non Latam	Hydroxy urea capsules USP 500mg
10	Georgia	Non Latam	Epirubicin Hcl for Injection USP 100 mg
11	Georgia	Non Latam	Ondansetron Injection USP 4mg/2mL
12	Georgia	Non Latam	Ondansetron Hcl injection 8mg/4mL
13	Georgia	Non Latam	Capecitabine tablets USP 500mg
14	Georgia	Non Latam	Carboplatin Injection BP 150mg/15mL
15	Georgia	Non Latam	Carboplatin Injection BP 450mg/45mL
16	Georgia	Non Latam	Doxorubicin Hydrochloride for Injection USP 10mg
17	Georgia	Non Latam	Doxorubicin Hcl for injection USP 50mg
18	Georgia	Non Latam	Fluorouracil injection IP/USP 250mg/5mL
19	Nigeria	Non Latam	Carboplatin Injection BP 450mg/45mL
20	Nigeria	Non Latam	Cisplatin injection BP 50mg/50mL
21	Nigeria	Non Latam	Doxorubicin Hcl for injection USP 50mg
22	Nigeria	Non Latam	Gemcitabine for injection USP 1000 mg
23	Nigeria	Non Latam	Gemcitabine for injection USP 200 mg
24	Nigeria	Non Latam	Oxaliplatin for Injection 100 mg
25	Peru	Latam	Doxorubicin Hydrochloride for Injection USP 10mg
26	Peru	Latam	Doxorubicin Hcl for injection USP 50mg
27	Peru	Latam	Bleomycin for Inj 15 units USP
28	Peru	Latam	Epirubicin Hcl for Injection USP 50 mg
29	Peru	Latam	Fludarabine Phosphate for inj USP 50 mg
30	Peru	Latam	Gemcitabine for injection USP 1000 mg
31	Peru	Latam	Vincristine sulphate for inj USP/IP 1mg
32	Peru	Latam	Zoledronic acid for injection 4mg
33	Peru	Latam	Dacarbazine for injection USP 200mg
34	Peru	Latam	Dactinomycin for Injection USP 0.5mg
35	Peru	Latam	Oxaliplatin for Injection 100 mg
36	Peru	Latam	Imatinib tablets 400mg
37	Peru	Latam	Ondansetron Hcl injection 8mg/4mL
38	Srilanka	Non Latam	Melphalan Tablets IP/USP 2mg
39	Syria	Non Latam	Cyclophosphamide injection IP 1000
40	Syria	Non Latam	Doxorubicin Hcl for injection USP 50mg
41	Syria	Non Latam	Doxorubicin Hydrochloride for Injection USP 10mg
42	Syria	Non Latam	Cytarabine injection IP/BP 100mg/mL
43	Syria	Non Latam	Cytarabine injection IP/BP 1000mg/10mL
44	Uzbekistan	Non Latam	Tamoxifen citrate Tablets IP/USP 10mg
45	Uzbekistan	Non Latam	Zoledronic acid for injection 4mg
46	Kenya	Non Latam	Propofol injection BP/USP 200mg/20ml
47	Kenya	Non Latam	Heparin Sodium Injection 5000 IU
Renewal

Sheet3:

Book1
	A	B	C
1	Country	Geography	Molecule description
2	Bhutan	Non Latam	Bupivacaine Hcl injection 100mg/20ml
3	Bhutan	Non Latam	Neostigmine Methylsulfate inj 2.5mg/5ml
4	Bhutan	Non Latam	Enoxaparin Sodium injection 60mg
5	Costarica(CCSS)	Latam	Succinylchloine Injection USP 500 mg/10 mL
6	DR Congo	Non Latam	Bicalutamide Tablets USP 50mg
7	DR Congo	Non Latam	Enoxaparin Sodium injection 40mg
8	DR Congo	Non Latam	Enoxaparin Sodium injection 60mg
9	DR Congo	Non Latam	Fluorouracil injection IP/USP 250mg/5mL
10	DR Congo	Non Latam	Vincristine sulphate for inj USP/IP 1mg
11	DR Congo	Non Latam	Oxaliplatin for Injection USP 50 mg
12	DR Congo	Non Latam	Methotrexate Injection IP/USP 1000mg
13	Ecuador	Latam	Doxorubicin Hydrochloride for Injection USP 10mg
14	Ecuador	Latam	Doxorubicin Hcl for injection USP 50mg
15	Ecuador	Latam	Thalidomide Capsules USP 100 mg
16	Ecuador	Latam	L-Asparaginase for Injection 10000IU
17	Georgia	Non Latam	Amphotericin B liposome injection 50mg
18	Georgia	Non Latam	Melphalan Tablets IP/USP 2mg
19	Georgia	Non Latam	Melphalan Tablets USP 5mg
20	Georgia	Non Latam	Chlormabucil tablets IP/USP 2mg
21	Georgia	Non Latam	Chlormabucil tablets IP/USP 5mg
22	Georgia	Non Latam	Lenalidomide Capsules 10 mg
23	Georgia	Non Latam	Lenalidomide Capsules 25 mg
24	Georgia	Non Latam	Abiraterone Acetate Tablets 250 mg
25	Georgia	Non Latam	Carmustine for injection USP 100mg
26	Georgia	Non Latam	Busulfan Injection 60mg(VIAL)
27	Iran	Non Latam	Chlormabucil tablets IP/USP 2mg
28	Iran	Non Latam	Fluorouracil injection IP/USP 250mg/5mL
29	Iran	Non Latam	Fluorouracil injection IP/USP500mg/10mL
30	Jamaica	Latam	Acetylcystine Injection BP 200mg/ml
31	Jamaica	Latam	Amphotericin B liposome injection 50mg
32	Jamaica	Latam	Bicalutamide Tablets USP 50mg
33	Jamaica	Latam	Bupivacaine Hcl Injection 50mg/20ml
34	Jamaica	Latam	Capecitabine tablets USP 500mg
35	Jamaica	Latam	Heparin Sodium IP/USP 25000IU/5mL
36	Jamaica	Latam	L-Asparaginase for Injection 10000IU (New Brand)
37	Jamaica	Latam	Melphalan injection IP/ BP 50mg
38	Jamaica	Latam	Methotrexate injection 50mg/2ml(amp)
39	Jamaica	Latam	sterile nor-adreline conc inj 4mg/2mL
40	Jamaica	Latam	Polymyxin B Sulphate for inj 500000 IU
41	Jamaica	Latam	Tranexamic acid injection BP 500mg
42	Jamaica	Latam	Vancomycin Hcl for inj IP/USP 1000mg
43	Kenya	Non Latam	Capecitabine tablets USP 500mg
44	Kenya	Non Latam	Bortezomib for injection 3.5 mg
45	Kenya	Non Latam	Carboplatin Injection BP 450mg/45mL
46	Kenya	Non Latam	Oxaliplatin for Injection USP 50 mg
47	Kenya	Non Latam	Zoledronic acid for injection 4mg
48	Kenya	Non Latam	Doxorubicin Hcl Liposomal Injection 50mg/25mL
49	Kenya	Non Latam	Paclitaxel NAB Inj. Suspension 100mg
50	Kenya	Non Latam	Dacarbazine for injection USP 200mg
New Registration

Output Required is :

one column is based on column A and another column is based on column C. So my columns may vary based on time so I need to select the column and specific Column where data has been filled.

Book1
	A	B	C	D	E	F
1	Country					Molecule description
2	Bhutan					Abiraterone Acetate Tablets 250 mg
3	Chile					Acetylcystine Injection BP 200mg/ml
4	Colombia					Adenosine injection USP 6mg/2mL
5	Costarica(CCSS)					Amphotericin B liposome injection 50mg
6	Dominican Republic					Anastrazole tablets IP 1mg
7	DR Congo					Atracurium Besylate injection 25mg
8	Ecuador					Bicalutamide Tablets USP 50mg
9	El Salvador					Bleomycin for Inj 15 units USP
10	Georgia					Bortezomib for injection 2mg
11	Guatemala					Bortezomib for injection 3.5 mg
12	Honduras					Bupivacaine Hcl in Dextrose Inj 20mg
13	Iran					Bupivacaine Hcl injection 100mg/20ml
14	Jamaica					Bupivacaine Hcl Injection 50mg/20ml
15	Kenya					Busulfan Injection 60mg
16	Nepal					Busulfan Injection 60mg(VIAL)
17	Nicaragua					Busulfan tablets 2mg
18	Nigeria					Capecitabine tablets USP 500mg
19	Paraguay					Carboplatin Injection BP 150mg/15mL
20	Peru					Carboplatin Injection BP 450mg/45mL
21	Philippines					Carmustine for injection USP 100mg
22	Srilanka					Chlormabucil tablets IP/USP 2mg
23	Syria					Chlormabucil tablets IP/USP 5mg
24	Trinidad & Tobago					Cisplatin injection BP 50mg/50mL
25	Uzbekistan					Cyclophosphamide injection IP 1000
26						Cyclophosphamide injection IP 200
27						Cyclophosphamide injection IP 500
28						Cytarabine injection IP/BP 1000mg/10mL
29						Cytarabine injection IP/BP 100mg/mL
30						Dacarbazine for injection USP 200mg
31						Dactinomycin for Injection USP 0.5mg
32						Doxorubicin Hcl for injection USP 50mg
33						Doxorubicin Hcl Liposomal Injection 50mg/25mL
34						Doxorubicin Hydrochloride for Injection USP 10mg
35						Enoxaparin Sodium injection 40mg
36						Enoxaparin Sodium injection 60mg
37						Epirubicin Hcl for Injection USP 100 mg
38						Epirubicin Hcl for Injection USP 50 mg
39						Fludarabine Phosphate for inj USP 50 mg
40						Fluorouracil injection IP/USP 250mg/5mL
41						Fluorouracil injection IP/USP500mg/10mL
42						Gemcitabine for injection USP 1000 mg
43						Gemcitabine for injection USP 200 mg
44						Heparin Sodium Injection 5000 IU
45						Heparin Sodium IP/USP 25000IU/5mL
46						Hydroxy urea capsules USP 500mg
47						Imatinib tablets 400mg
48						Irinotecan Hcl Injection IP 100mg/5mL
49						Irinotecan Hcl Injection IP 40mg/2mL
50						L-Asparaginase for Injection 10000IU
51						L-Asparaginase for Injection 10000IU (New Brand)
52						Lenalidomide Capsules 10 mg
53						Lenalidomide Capsules 25 mg
54						Melphalan injection IP/ BP 50mg
55						Melphalan Tablets IP/USP 2mg
56						Melphalan Tablets USP 5mg
57						Methotrexate injection 50mg/2ml(amp)
58						Methotrexate Injection IP/USP 1000mg
59						Neostigmine Methylsulfate inj 2.5mg/5ml
60						Ondansetron Hcl injection 8mg/4mL
61						Ondansetron Injection USP 4mg/2mL
62						Oxaliplatin for Injection 100 mg
63						Oxaliplatin for Injection USP 50 mg
64						Paclitaxel NAB Inj. Suspension 100mg
65						Polymyxin B Sulphate for inj 500000 IU
66						Propofol injection BP/USP 200mg/20ml
67						sterile nor-adreline conc inj 4mg/2mL
68						Succinylchloine Injection USP 500 mg/10 mL
69						Tamoxifen citrate Tablets IP/USP 10mg
70						Thalidomide Capsules USP 100 mg
71						Tranexamic acid injection BP 500mg
72						Vancomycin Hcl for inj IP/USP 1000mg
73						Vincristine sulphate for inj USP/IP 1mg
74						Zoledronic acid for injection 4mg
Unique value

Thanks in advance.

Regards,
Ravi

 

[Zot]

Where you want your out located, same or new workbook?

 

[ravi2628]

Where you want your out located, same or new workbook?

Same workbook

 

[Zot]

Try this

Option Compare Text

Sub GetUnique()

Dim strCombo As String, col1 As String, col2 As String
Dim nRow As Long
Dim key As Variant
Dim cell As Range, rngData As Range
Dim ws As Worksheet, wsU As Worksheet
Dim wb As Workbook
Dim dict As Object

Set wb = ActiveWorkbook
Set wsU = wb.Sheets("Unique Value")
Set dict = CreateObject("Scripting.Dictionary")

For Each ws In wb.Sheets
    If Not ws.Name = "Unique Value" Then
        Set rngData = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        For Each cell In rngData
            strCombo = ws.Range("A" & cell.Row) & "," & ws.Range("C" & cell.Row)
            If Not dict.Exists(strCombo) Then
                dict.Add strCombo, Nothing
            End If
        Next
    End If
Next

col1 = Application.InputBox("Please enter Country column")
col2 = Application.InputBox("Please enter Molecule Description column")

nRow = 1
For Each key In dict
    nRow = nRow + 1
    With wsU
        .Range(col1 & nRow) = Split(key, ",")(0)
        .Range(col2 & nRow) = Split(key, ",")(1)
    End With
Next

End Sub

 

[ravi2628]

Try this

Option Compare Text

Sub GetUnique()

Dim strCombo As String, col1 As String, col2 As String
Dim nRow As Long
Dim key As Variant
Dim cell As Range, rngData As Range
Dim ws As Worksheet, wsU As Worksheet
Dim wb As Workbook
Dim dict As Object

Set wb = ActiveWorkbook
Set wsU = wb.Sheets("Unique Value")
Set dict = CreateObject("Scripting.Dictionary")

For Each ws In wb.Sheets
    If Not ws.Name = "Unique Value" Then
        Set rngData = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        For Each cell In rngData
            strCombo = ws.Range("A" & cell.Row) & "," & ws.Range("C" & cell.Row)
            If Not dict.Exists(strCombo) Then
                dict.Add strCombo, Nothing
            End If
        Next
    End If
Next

col1 = Application.InputBox("Please enter Country column")
col2 = Application.InputBox("Please enter Molecule Description column")

nRow = 1
For Each key In dict
    nRow = nRow + 1
    With wsU
        .Range(col1 & nRow) = Split(key, ",")(0)
        .Range(col2 & nRow) = Split(key, ",")(1)
    End With
Next

End Sub

Hi Zot,

When I was Using the Code I was Getting Duplicate Values in the data

and from hidden sheets also data is being taken by the macro.

For your reference, I was sharing a snapshot.

 

[Zot]

I guess I did not understand your requirement fully. I thought you were talking about unique combination of Country and Molecule Description. I seems like you want them separately, unique Country list and unique Molecule Description list. Is this right?

If that is so then try this

Option Compare Text

Sub GetUnique()

Dim strCombo As String, col1 As String, col2 As String
Dim nRow As Long
Dim key As Variant
Dim cellC As Range, rngC As Range
Dim cellMD As Range, rngMD As Range
Dim ws As Worksheet, wsU As Worksheet
Dim wb As Workbook
Dim dictC As Object, dictMD As Object

Set wb = ActiveWorkbook
Set wsU = wb.Sheets("Unique Value")
Set dictC = CreateObject("Scripting.Dictionary")
Set dictMD = CreateObject("Scripting.Dictionary")

For Each ws In wb.Sheets
    If Not ws.Name = "Unique Value" Then
        Set rngC = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        Set rngMD = ws.Range("C2", ws.Cells(Rows.Count, "C").End(xlUp))
        For Each cellC In rngC
            If Not dictC.Exists(cellC.Value) Then
                dictC.Add cellC.Value, Nothing
            End If
        Next
        For Each cellMD In rngMD
            If Not dictMD.Exists(cellMD.Value) Then
                dictMD.Add cellMD.Value, Nothing
            End If
        Next
    End If
Next

col1 = Application.InputBox("Please enter Country column")
col2 = Application.InputBox("Please enter Molecule Description column")

nRow = 1
For Each key In dictC
    nRow = nRow + 1
    With wsU
        .Range(col1 & nRow) = key
    End With
Next
nRow = 1
For Each key In dictMD
    nRow = nRow + 1
    With wsU
        .Range(col2 & nRow) = key
    End With
Next

End Sub

 

[ravi2628]

I guess I did not understand your requirement fully. I thought you were talking about unique combination of Country and Molecule Description. I seems like you want them separately, unique Country list and unique Molecule Description list. Is this right?

If that is so then try this

Option Compare Text

Sub GetUnique()

Dim strCombo As String, col1 As String, col2 As String
Dim nRow As Long
Dim key As Variant
Dim cellC As Range, rngC As Range
Dim cellMD As Range, rngMD As Range
Dim ws As Worksheet, wsU As Worksheet
Dim wb As Workbook
Dim dictC As Object, dictMD As Object

Set wb = ActiveWorkbook
Set wsU = wb.Sheets("Unique Value")
Set dictC = CreateObject("Scripting.Dictionary")
Set dictMD = CreateObject("Scripting.Dictionary")

For Each ws In wb.Sheets
    If Not ws.Name = "Unique Value" Then
        Set rngC = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        Set rngMD = ws.Range("C2", ws.Cells(Rows.Count, "C").End(xlUp))
        For Each cellC In rngC
            If Not dictC.Exists(cellC.Value) Then
                dictC.Add cellC.Value, Nothing
            End If
        Next
        For Each cellMD In rngMD
            If Not dictMD.Exists(cellMD.Value) Then
                dictMD.Add cellMD.Value, Nothing
            End If
        Next
    End If
Next

col1 = Application.InputBox("Please enter Country column")
col2 = Application.InputBox("Please enter Molecule Description column")

nRow = 1
For Each key In dictC
    nRow = nRow + 1
    With wsU
        .Range(col1 & nRow) = key
    End With
Next
nRow = 1
For Each key In dictMD
    nRow = nRow + 1
    With wsU
        .Range(col2 & nRow) = key
    End With
Next

End Sub

The new code is working fine but it is taking hidden sheet cell values also so please help me with that.

 

[ravi2628]

Can it be possible to Select only Visible worksheets in the macro?

 

[Zot]

Can it be possible to Select only Visible worksheets in the macro?

Add this condition

For Each ws In wb.Sheets
    If Not ws.Name = "Unique Value" And ws.Visible = xlSheetVisible Then
        Set rngC = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))

 

[ravi2628]

Add this condition

For Each ws In wb.Sheets
    If Not ws.Name = "Unique Value" And ws.Visible = xlSheetVisible Then
        Set rngC = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))

Thanks Zot Your logic helped me a lot