Vba to make duplicate references to unique

Panoos64 · Sep 16, 2019

Hi all of you, kindly require to provide me a VBA code so that, to run through col. “B” and where the reference is duplicate should add a letter at left side of the reference, starting from letter “A”. Therefore, that is double entry and so the letter should place the same in 2 lines and so on…. I present below the original data and expected result. Thank you all in advance.

Original data

 [TABLE="class: MsoNormalTable, width: 211"]
<tbody>[TR]
[TD="width: 28"][/TD]
[TD="width: 162"]

A

[/TD]
[TD="width: 162"]

B

[/TD]
[/TR]
[TR]
[TD="width: 28"]

1

[/TD]
[TD="width: 162"]

Date

[/TD]
[TD="width: 162"]

Reference 1

[/TD]
[/TR]
[TR]
[TD="width: 28"]

2

[/TD]
[TD="width: 162"]

25/06/2019

[/TD]
[TD="width: 162"]

82512453

[/TD]
[/TR]
[TR]
[TD="width: 28"]

3

[/TD]
[TD="width: 162"]

25/06/2019

[/TD]
[TD="width: 162"]

82512453

[/TD]
[/TR]
[TR]
[TD="width: 28"]

4

[/TD]
[TD="width: 162"]

28/06/2019

[/TD]
[TD="width: 162"]

83045628

[/TD]
[/TR]
[TR]
[TD="width: 28"]

5

[/TD]
[TD="width: 162"]

28/06/2019

[/TD]
[TD="width: 162"]

83045628

[/TD]
[/TR]
[TR]
[TD="width: 28"]

6

[/TD]
[TD="width: 162"]

30/06/2019

[/TD]
[TD="width: 162"]

82512453

[/TD]
[/TR]
[TR]
[TD="width: 28"]

7

[/TD]
[TD="width: 162"]

30/06/2019

[/TD]
[TD="width: 162"]

82512453

[/TD]
[/TR]
</tbody>[/TABLE]

Expected result

 [TABLE="class: MsoNormalTable, width: 211"]
<tbody>[TR]
[TD="width: 28"][/TD]
[TD="width: 162"]

A

[/TD]
[TD="width: 162"]

B

[/TD]
[/TR]
[TR]
[TD="width: 28"]

1

[/TD]
[TD="width: 162"]

Date

[/TD]
[TD="width: 162"]

Reference 1

[/TD]
[/TR]
[TR]
[TD="width: 28"]

2

[/TD]
[TD="width: 162"]

25/06/2019

[/TD]
[TD="width: 162"]

A82512453

[/TD]
[/TR]
[TR]
[TD="width: 28"]

3

[/TD]
[TD="width: 162"]

25/06/2019

[/TD]
[TD="width: 162"]

A82512453

[/TD]
[/TR]
[TR]
[TD="width: 28"]

4

[/TD]
[TD="width: 162"]

28/06/2019

[/TD]
[TD="width: 162"]

83045628

[/TD]
[/TR]
[TR]
[TD="width: 28"]

5

[/TD]
[TD="width: 162"]

28/06/2019

[/TD]
[TD="width: 162"]

83045628

[/TD]
[/TR]
[TR]
[TD="width: 28"]

6

[/TD]
[TD="width: 162"]

30/06/2019

[/TD]
[TD="width: 162"]

B82512453

[/TD]
[/TR]
[TR]
[TD="width: 28"]

7

[/TD]
[TD="width: 162"]

30/06/2019

[/TD]
[TD="width: 162"]

B82512453

[/TD]
[/TR]
</tbody>[/TABLE]

Akuini · Sep 17, 2019

Here's another way, but it requires that you can sort data by col B. Sorting data by col B will make it easier to code & also faster.
So, sort the data manually by col B then run this code:

Code:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109898b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1109898-vba-make-duplicate-references-unique.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va
[COLOR=Royalblue]Dim[/COLOR] tx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

va = Range([COLOR=brown]"B1"[/COLOR], Cells(Rows.count, [COLOR=brown]"B"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
vb = Range([COLOR=brown]"B1"[/COLOR], Cells(Rows.count, [COLOR=brown]"B"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    k = [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Do[/COLOR]
        [COLOR=Royalblue]If[/COLOR] i > UBound(va, [COLOR=crimson]1[/COLOR]) - [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
        i = i + [COLOR=crimson]1[/COLOR]
        [COLOR=Royalblue]If[/COLOR] va(i, [COLOR=crimson]1[/COLOR]) = va(i - [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
        tx = Split(Cells([COLOR=crimson]1[/COLOR], k).Address, [COLOR=brown]"$"[/COLOR])([COLOR=crimson]1[/COLOR]) & va(i, [COLOR=crimson]1[/COLOR])
            vb(i, [COLOR=crimson]1[/COLOR]) = tx: vb(i - [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR]) = tx
            k = k + [COLOR=crimson]1[/COLOR]: i = i + [COLOR=crimson]1[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
        [COLOR=Royalblue]If[/COLOR] i > UBound(va, [COLOR=crimson]1[/COLOR]) [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]Do[/COLOR]
    [COLOR=Royalblue]Loop[/COLOR] [COLOR=Royalblue]While[/COLOR] va(i, [COLOR=crimson]1[/COLOR]) = va(i - [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR])
    i = i - [COLOR=crimson]1[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

Range([COLOR=brown]"B1"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR]) = vb

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

Panoos64 · Sep 19, 2019

Hi Akuini, the code works but the issue is that, the code place letter too in the pair of reference which exists just once. In my above example the reference 83045628 should not be affected. I recognized that is so complicate and so i will modify it by manual method. However i would like to thank you for your support and your time to resolve my project. Have a great day!

Panoos64 · Sep 19, 2019

Hi Trebor, I will use your first code which works and for any adjustments after running your code i will do it by manual method. I am so shy to require further support from you and general all team. Your support is enough for me and due to you i avoid manual work. Your second code it doesn't affect my data and it doesn't place the letters. However i will use your first post and i would like to thank you once again for your support and your time you spent for my project. All the best to you!

Akuini · Sep 19, 2019

Panoos64 said:
Hi Akuini, the code works but the issue is that, the code place letter too in the pair of reference which exists just once. I

Ah, sorry, I forgot about that.
Try this one instead:

Code:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109898b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1109898-vba-make-duplicate-references-unique.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va
[COLOR=Royalblue]Dim[/COLOR] tx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range

[COLOR=Royalblue]Set[/COLOR] c = Range([COLOR=brown]"B1"[/COLOR], Cells(Rows.count, [COLOR=brown]"B"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
va = c: vb = c

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    k = [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]If[/COLOR] WorksheetFunction.CountIf(c, va(i, [COLOR=crimson]1[/COLOR])) > [COLOR=crimson]3[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        [COLOR=Royalblue]Do[/COLOR]
            [COLOR=Royalblue]If[/COLOR] i > UBound(va, [COLOR=crimson]1[/COLOR]) - [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
            i = i + [COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]If[/COLOR] va(i, [COLOR=crimson]1[/COLOR]) = va(i - [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
            tx = Split(Cells([COLOR=crimson]1[/COLOR], k).Address, [COLOR=brown]"$"[/COLOR])([COLOR=crimson]1[/COLOR]) & va(i, [COLOR=crimson]1[/COLOR])
                vb(i, [COLOR=crimson]1[/COLOR]) = tx: vb(i - [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR]) = tx
                k = k + [COLOR=crimson]1[/COLOR]: i = i + [COLOR=crimson]1[/COLOR]
            [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
            [COLOR=Royalblue]If[/COLOR] i > UBound(va, [COLOR=crimson]1[/COLOR]) [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]Do[/COLOR]
        [COLOR=Royalblue]Loop[/COLOR] [COLOR=Royalblue]While[/COLOR] va(i, [COLOR=crimson]1[/COLOR]) = va(i - [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR])
        i = i - [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

Range([COLOR=brown]"B1"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR]) = vb

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

Panoos64 · Sep 19, 2019

Well done Akuini!! Is perfect now. I express a great thanks to you and i appreciated so much the work you done for me. All the best to you!!!

Akuini · Sep 19, 2019

You're welcome, glad to help, & thanks for the feedback.

Trebor76 · Sep 19, 2019

Your second code it doesn't affect my data and it doesn't place the letters.

That's odd - it worked for me

I'm glad Akuini was able to provide with a workable solution nonetheless.

Panoos64 · Sep 20, 2019

Hi Trebor, let me test it again and i will let you know. Just i am writing for feedback records. Therefore that i appreciate your time for such complicate code attempting to resolve my project. Have a great day!

Panoos64 · Sep 26, 2019

Hi Trebor, i tested and it works now by changing the point (column) "A" to "B". Kindly note that base on my data the column which i wanted to effect was the "B". However i would like to express my thanks once again for your time spent for my project and my apologies for my delay respond. All the best!

Vba to make duplicate references to unique

Panoos64

Well-known Member

Akuini

Well-known Member

Excel Facts

Panoos64

Well-known Member

Panoos64

Well-known Member

Akuini

Well-known Member

Panoos64

Well-known Member

Akuini

Well-known Member

Trebor76

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

Similar threads

Forum statistics

Share this page

Vba to make duplicate references to unique

Well-known Member

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock