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

	A	B
1	Date	Reference 1
2	25/06/2019	82512453
3	25/06/2019	82512453
4	28/06/2019	83045628
5	28/06/2019	83045628
6	30/06/2019	82512453
7	30/06/2019	82512453

Expected result

	A	B
1	Date	Reference 1
2	25/06/2019	A82512453
3	25/06/2019	A82512453
4	28/06/2019	83045628
5	28/06/2019	83045628
6	30/06/2019	B82512453
7	30/06/2019	B82512453

Trebor76 · Sep 16, 2019

Hi Panoos64,

Try this macro while on the sheet with the data:

Code:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long, lngMyRow As Long, lngRowOffset As Long
    Dim intCHR As Integer
    Dim varReference As Variant
    Dim dteMyDate As Date
    
    Application.ScreenUpdating = False

    lngLastRow = Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    intCHR = 65 'Initial letter setting - 65 is 'A'
    
    For lngMyRow = 2 To lngLastRow
        'If the Reference is numeric it hasn't been prefixed with a letter, so...
        If IsNumeric(Range("B" & lngMyRow).Value) = True Then
            '...run this code
            If Evaluate("COUNTIFS($A$2:$A$" & lngLastRow & ",A" & lngMyRow & ",$B$2:$B$" & lngLastRow & ",B" & lngMyRow & ")") > 1 Then
                dteMyDate = CDate(Range("A" & lngMyRow).Value)
                lngRowOffset = 0
                varReference = Range("B" & lngMyRow).Value
                Do Until lngMyRow + lngRowOffset > lngLastRow
                    If Range("A" & lngMyRow + lngRowOffset).Value = dteMyDate And Range("B" & lngMyRow + lngRowOffset).Value = varReference Then
                        Range("B" & lngMyRow + lngRowOffset).Value = Chr(intCHR) & Range("B" & lngMyRow + lngRowOffset).Value
                    End If
                lngRowOffset = lngRowOffset + 1
                Loop
                intCHR = intCHR + 1
            End If
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True
                  
End Sub

Regards,

Robert

Akuini · Sep 16, 2019

I don't quite understand what the criteria is.
1. Are the dates part of the criteria? in what way?
2. Why 83045628 don't get a letter? there are 2 of them.
3. Can the data be like this below (I add row 4)? If yes what the result should look like?

	A	B
1	Date	Reference 1
2	25/06/2019	82512453
3	25/06/2019	82512453
4	25/06/2019	82512453
5	28/06/2019	83045628
6	28/06/2019	83045628
7	30/06/2019	82512453
8	30/06/2019	82512453

Rick Rothstein · Sep 16, 2019

Panoos64 said:
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”.

What letter(s) should be prepended if there are more than 26 such duplicate groupings?

Panoos64 · Sep 17, 2019

Hi Trebor, thanks you for your support. It works but its enter letter in reference which is not duplicate. Therefore that, due to double entry, duplicate lines for my project it means that exists twice, three or four times double reference (pairs of same reference 1). In my above extract the lines 4 & 5 are not duplicate (28/06/19 83045628). However the code works and i would much appreciated if you could amend it so much to ignore in case that exists just once the same pair of references. Thank you once again for your attempt to resolve my project. Have a great day!

Panoos64 · Sep 17, 2019

Hi Rick, In such case is it possible to place / begin two letters, e.g. "AB" and so on...? Thank you for your clarification. Have a nice day

Panoos64 · Sep 17, 2019

Hi Akuini,
1. Dates are not part of criteria. I wrote them just as information.
2. Duplicate for my project i was meaning pairs of references. Therefore that the ref. 83045628 is not duplicate and should not be affected.
3. Yes and thank you for your note. Usually my data are like below:

	A	B
1	Date	Reference 1
2	25/06/2019	A82512453
3	25/06/2019	B82512453
4	25/06/2019	C82512453
6	28/06/2019	83045628
7	28/06/2019	83045628
8	25/06/2019	A82512453
9	25/06/2019	B82512453
11	25/06/2019	C82512453

Please all, therefore that, usually my data are like above and i express my apologies that, i did not mention it in my first post. Thank you all!

Rick Rothstein · Sep 17, 2019

@Panoos64,

I am not sure about anyone else, but I am now completely confused as to what you want. Only three or more contiguous repeats are given letters? In you first post those letters were the same for each group and now they are the same alphabetical for each group???? What about other repeated reference numbers that may appear in between? You are going to have to clarify what you are trying to achieve in a lot more detail.

Panoos64 · Sep 17, 2019

Hi Rick, No are not alphabetical. I just prepared the expected result. Actually i want to make unique any group of same references BUT the pair / doublet of them. e.g. ref. 82512453 exists in col. 'B" six times i wanted to group them the first group, (pair) to be A82512453 second group (pair) B82512453 and so on.... Please see below original data and expected result. I would like to thank you once again for your great support. Have a lovely day!

Original data

	A	B
1	Date	Reference 1
2	25/06/2019	82512453
3	25/06/2019	82512453
4	25/06/2019	82512453
6	28/06/2019	83045628
7	28/06/2019	83045628
8	25/06/2019	82512453
9	25/06/2019	82512453
11	25/06/2019	82512453

Expected result

	A	B
1	Date	Reference 1
2	25/06/2019	A82512453
3	25/06/2019	B82512453
4	25/06/2019	C82512453
6	28/06/2019	83045628
7	28/06/2019	83045628
8	25/06/2019	A82512453
9	25/06/2019	B82512453
11	25/06/2019	C82512453

Trebor76 · Sep 17, 2019

Dates are not part of criteria. I wrote them just as information.

Please post your data as per your requirements. I wrote my original code to tag the references for each date which was a waste of time.

Duplicate for my project i was meaning pairs of references.

Again this should have been noted your original post.

That said, see how this goes:

Code:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngMyRow As Long
    Dim lngRowOffset As Long
    Dim lngMyCount As Long
    Dim lngMyCol As Long
    Dim i As Long
    Dim clnMyCols As New Collection
    Dim varMyCol As Variant
    Dim varReference As Variant
    Dim blnAddPrefix As Boolean
        
    Application.ScreenUpdating = False
    
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
        
    For lngMyRow = 2 To lngLastRow
        'Only match if the entry is numeric and there's at least 2 pairs (4 duplicates)
        If IsNumeric(Range("A" & lngMyRow).Value) = True Then
            lngMyCount = Evaluate("COUNTIFS($A$2:$A$" & lngLastRow & ",A" & lngMyRow & ")")
            If lngMyCount > 2 And lngMyCount Mod 2 = 0 Then
                varReference = Range("A" & lngMyRow)
                blnAddPrefix = True
                lngRowOffset = 0
                Do Until lngMyRow + lngRowOffset > lngLastRow
                    If blnAddPrefix = True Then
                        If Range("A" & lngMyRow).Offset(lngRowOffset, 0).Value = varReference Then
                            lngMyCol = lngMyCol + 1
                            Range("A" & lngMyRow + lngRowOffset).Value = ColLetter(lngMyCol) & varReference
                            clnMyCols.Add ColLetter(lngMyCol)
                        Else
                            blnAddPrefix = False
                        End If
                    Else
                        If Range("A" & lngMyRow).Offset(lngRowOffset, 0).Value = varReference Then
                            For Each varMyCol In clnMyCols
                                Range("A" & lngMyRow + lngRowOffset).Value = varMyCol & varReference
                                clnMyCols.Remove (1)
                                Exit For
                            Next varMyCol
                        End If
                    End If
                    lngRowOffset = lngRowOffset + 1
                Loop
            End If
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True
                  
End Sub
Function ColLetter(lngColNumber As Long) As String

    'The following was sourced from here: _
    https://stackoverflow.com/questions/37475970/increment-excel-column-reference-using-vba-z-to-aa-aa-to-ab

    If lngColNumber < 27 Then
        ColLetter = Chr(64 + lngColNumber)
    Else
        ColLetter = Chr(64 + Int(lngColNumber / 26)) & Chr(64 + lngColNumber - (Int(lngColNumber / 26) * 26))
    End If

End Function

Regards,

Robert

Vba to make duplicate references to unique

Panoos64

Well-known Member

Excel Facts

Trebor76

Well-known Member

Akuini

Well-known Member

Rick Rothstein

MrExcel MVP

Panoos64

Well-known Member

Panoos64

Well-known Member

Panoos64

Well-known Member

Rick Rothstein

MrExcel MVP

Panoos64

Well-known Member

Trebor76

Well-known Member

Similar threads

Forum statistics

Share this page

Vba to make duplicate references to unique

Well-known Member

Excel Facts

Well-known Member

Well-known Member

MrExcel MVP

Well-known Member

Well-known Member

Well-known Member

MrExcel MVP

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