Add Trailing Count Number For Each Duplicate Value

I import data and there are several account numbers in Col A on sheet "Imported data" that have the same account number that was downloaded from another program which stored the account number in one field and a sub-number in another field. When downloading the sub-field in not part of the download

I would like a macro to place a 01 to end of the number that appears a second time in Col A 02 to the number when it appears a second time 03 a third time etc etc eg if 7189 appears a second time 01 to be shown at the end 718901 , if it appears again 718902. If 7000 appears a second time 01 to be placed at the end 700001 a second time 700002 etc

I have attached sample data and have shown what the numbers in Col A should look like after the macro has run (sheet "data after correction")

Attachment 770


Your assistance in this regard is most appreciated

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
ttps://www.youtube.com/watch?v=LP9fz2DCMBE
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg. 9wdo_rWgxSH9wdpcYqrvp8
ttps://www.youtube.com/watch?v=bFxnXH4-L1A
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg
ttps://www.youtube.com/watch?v=GqzeFYWjTxI
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Hi

try

Code:

---

Option Explicit

Sub kTest()
   
    Dim d, t, i As Long, r As Range
   
    Set r = Range("a7:a" & Range("a" & Rows.Count).End(3).Row)
    d = r.Value
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(d, 1)
            If IsNumeric(d(i, 1)) Then
                t = .Item(d(i, 1))
                If Not IsEmpty(t) Then
                    If t > 0 Then
                        .Item(d(i, 1)) = t + 1
                        d(i, 1) = d(i, 1) & Format(t, "00")
                    End If
                Else
                    .Item(d(i, 1)) = 1
                End If
            End If
        Next
        r.Value = d
    End With
       
End Sub

---

If the account numbers are actually numbers, you can use B7=IF(ISNUMBER(A7),TEXT(COUNTIF(A7:A$7,A7),"00")," ") and drag down.

However, if you just want to use the formula in those cells that have the account numbers, use B7=TEXT(COUNTIF(A7:A$7,A7),"00")

Actually, follow admin's suggestion. I just realized you were looking for something else.

Anyway, for the sake of correcting my formula, here's what you can use in B7 and drag down

=IF(ISNUMBER(A7),A7,"")&IF(AND(ISNUMBER(A7),COUNTI F(A7:A$7,A7)-1),TEXT(COUNTIF(A7:A$7,A7)-1,"00"),"")

Here is another macro for you to consider...

Code:

---

Sub AffixDuplicateCounts()
  Dim X As Long, LastRow As Long, RepeatCount As Long
  Const StartRow As Long = 5
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For X = LastRow To StartRow Step -1
    If Application.IsNumber(Cells(X, "A").Value) Then
      RepeatCount = Application.CountIf(Cells(StartRow, "A"). _
                    Resize(X - StartRow + 1), Cells(X, "A").Value)
      If RepeatCount > 1 Then
        Cells(X, "A").Value = Cells(X, "A").Value & Format(RepeatCount - 1, "00")
      End If
    End If
  Next
End Sub

---

Cross posted (with some answers) here...

Macro to create Sub-account numbers

Hi Guys

Thanks for the help, much appreciated

Regards

Howard

Howardc, there has been clear guidelines given about cross-posting. if you have to x-post, please mention the link on all the pages you've posted. Hope you'll comply to this in the future.

My apologies. I usually mention the ink when cross-posting. Will ensure that I do this in future

Regards

Howard

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm 9wlhQrYJP3M
ttps://www.youtube.com/watch?v=LP9fz2DCMBE
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg. 9wdo_rWgxSH9wdpcYqrvp8
ttps://www.youtube.com/watch?v=bFxnXH4-L1A
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg
ttps://www.youtube.com/watch?v=GqzeFYWjTxI
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA