Page 1 of 2 12 LastLast
Results 1 to 10 of 19

Thread: Vba to make duplicate references to unique

  1. #1
    Board Regular
    Join Date
    Mar 2014
    Location
    cyprus
    Posts
    774
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Vba to make duplicate references to unique

    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

    Last edited by Panoos64; Sep 16th, 2019 at 09:18 AM.

  2. #2
    Board Regular
    Join Date
    Jul 2007
    Location
    Sydney
    Posts
    4,392
    Post Thanks / Like
    Mentioned
    7 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Vba to make duplicate references to unique

    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

  3. #3
    Board Regular Akuini's Avatar
    Join Date
    Feb 2016
    Location
    Indonesia
    Posts
    2,074
    Post Thanks / Like
    Mentioned
    36 Post(s)
    Tagged
    4 Thread(s)

    Default Re: Vba to make duplicate references to unique

    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

  4. #4
    MrExcel MVP Rick Rothstein's Avatar
    Join Date
    Apr 2011
    Location
    New Jersey, USA
    Posts
    35,251
    Post Thanks / Like
    Mentioned
    92 Post(s)
    Tagged
    33 Thread(s)

    Default Re: Vba to make duplicate references to unique

    Quote Originally Posted by Panoos64 View Post
    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?
    Rick's "mini" blog... http://www.excelfox.com/forum/f22/
    .
    Want to post a small screen shot? See Part B here.

  5. #5
    Board Regular
    Join Date
    Mar 2014
    Location
    cyprus
    Posts
    774
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Vba to make duplicate references to unique

    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!

  6. #6
    Board Regular
    Join Date
    Mar 2014
    Location
    cyprus
    Posts
    774
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Vba to make duplicate references to unique

    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

  7. #7
    Board Regular
    Join Date
    Mar 2014
    Location
    cyprus
    Posts
    774
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Vba to make duplicate references to unique

    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!
    Last edited by Panoos64; Sep 17th, 2019 at 01:32 AM.

  8. #8
    MrExcel MVP Rick Rothstein's Avatar
    Join Date
    Apr 2011
    Location
    New Jersey, USA
    Posts
    35,251
    Post Thanks / Like
    Mentioned
    92 Post(s)
    Tagged
    33 Thread(s)

    Default Re: Vba to make duplicate references to unique

    @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.
    Rick's "mini" blog... http://www.excelfox.com/forum/f22/
    .
    Want to post a small screen shot? See Part B here.

  9. #9
    Board Regular
    Join Date
    Mar 2014
    Location
    cyprus
    Posts
    774
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Vba to make duplicate references to unique

    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
    Last edited by Panoos64; Sep 17th, 2019 at 04:07 AM.

  10. #10
    Board Regular
    Join Date
    Jul 2007
    Location
    Sydney
    Posts
    4,392
    Post Thanks / Like
    Mentioned
    7 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Vba to make duplicate references to unique

    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

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •