Excel Macro to add a character to duplicate values after the value exceeds 15 instances - excel

Question

Currently operating in excel 2010
I am in the process of building a macro to format various reports so that the excel sheets can be input into an auto-load tool. This macro adds a unique number identifier to each case and then breaks cases into multiple lines depending on the amount of services being performed. So initially cases will be numbered in column A as 1,2,3,4,ect. Then the cases are split into multiple rows based on the number of services and the number in column A is used to group the services. So if case one has 3 services, case two has 1 service, and case three has 5 services, column A would look like 1,1,1,2,3,3,3,3,3 descending.
The auto-load tool only builds 15 lines per case. So I need to add code that will search column A and if a duplicate value exceeds 15 instances, add an "a" to the first 15 instances, a "b" to the second 15 instances, a "c" to the third 15 instances, and so on.
example:
In column A desending: if identifier looks like 1,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4
Then macro would update column A to look like this: 1,2,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3b,3b,4
Thanks for your time
This is the code I have worked out so far:
Sub Scrub_File()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
range("A2").Select
ActiveCell.FormulaR1C1 = "1"
LastRow = range("K" & Rows.Count).End(xlUp).Row
range("A2").AutoFill Destination:=range("A2:A" & LastRow), Type:=xlFillSeries
Dim InxSplit As Long
Dim SplitCell() As String
Dim RowCrnt As Long
With Worksheets("Sheet1")
RowCrnt = 2 ' The first row containing data.
Do While True
If .Cells(RowCrnt, "AI").Value = "End" Then
Exit Do
End If
SplitCell = Split(.Cells(RowCrnt, "AI").Value, ",")
If UBound(SplitCell) > 0 Then
.Cells(RowCrnt, "AI").Value = SplitCell(0)
For InxSplit = 1 To UBound(SplitCell)
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "AI").Value = SplitCell(InxSplit)
.range(.Cells(RowCrnt, "A"), .Cells(RowCrnt, "AH")).Value = .range(.Cells(RowCrnt - 1, "A"), .Cells(RowCrnt - 1, "AH")).Value
.range(.Cells(RowCrnt, "AL"), .Cells(RowCrnt, "AX")).Value = .range(.Cells(RowCrnt - 1, "AL"), .Cells(RowCrnt - 1, "AX")).Value
Next
End If
RowCrnt = RowCrnt + 1
Loop
End With
End Sub

Answer 1

For an Excel formula, you can use:
=IF(COUNTIF($A:$A,A3)>15, A3&CHAR(96+INT( (COUNTIF($A$3:A3,A3)-1)/15+1)),A3)
where your ID codes are in column A and start at, for example A3.
For a VBA macro, to be run after you have populated your ID column:
Option Explicit
Sub markDups()
Dim WB As Workbook, WS As Worksheet
Dim rID As Range, C As Range, D As Range
Dim lcntID As Long, lposCnt As Long
Set WB = ThisWorkbook
Set WS = WB.Worksheets("sheet1")
With WS
Set rID = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)) 'alter as needed
End With
For Each C In rID
Set D = C.Offset(0, 1) 'remove offset to overwrite
lcntID = WorksheetFunction.CountIf(rID, C.Value2)
If lcntID > 15 Then
Set D = C.Offset(0, 1) 'remove offset to overwrite
lposCnt = WorksheetFunction.CountIf(Range(rID(1, 1), C), C)
D = C.Value2 & Chr((lposCnt - 1) \ 15 + 97)
Else
D = C.Value2
End If
Next C
End Sub