Change value of a range of cells, when a row limit is met

If you must use VBA:

Sub NumberIfVariableRowLimit()
    
    Dim I As Long           'Iterate
    Dim SrcRG As Range      'Source Range
    Dim SrcArray()          'Source Array
    Dim DestArray()         'Destination array
    Dim CellCnt As Long     'Count of cells in range
    Dim ItemCnt As Long     'Count keeping track of item number for each name
    Dim TempCnt As Long     'Count of occurances of this item in source array
    Dim TempStr As String   'Most recently checked item
    Dim RowLimit As Long    'Row limit
    
    RowLimit = 3            'Source this data however you like.
    
        'Range/Array Setup
    Set SrcRG = ActiveSheet.Range("B1:B28") 'Source Range
    CellCnt = SrcRG.Count               'Count cells in source range
    SrcArray = SrcRG                    'Store range values in array
    ReDim DestArray(1 To CellCnt)       'Resize output array
    
    TempStr = "%&%"                     'Initial Value
    
    For I = 1 To CellCnt                'Iterate through array
        ItemCnt = CountIfArray(SrcArray, SrcArray(I, 1))    'Get occurances of item in array
            
            'change -or- notchange value, move to output array
        If ItemCnt > RowLimit Then
            If TempStr = SrcArray(I, 1) Then
                TempCnt = TempCnt + 1
            Else
                TempCnt = RowLimit
            End If
            DestArray(I) = SrcArray(I, 1) & " " & Application.WorksheetFunction.RoundDown(TempCnt / RowLimit, 0)
        Else
            DestArray(I) = SrcArray(I, 1)
        End If
        
        TempStr = SrcArray(I, 1)    'Store item value for next iteration
    Next I
    
    Sheet1.Range("C1").Resize(CellCnt, 1).Value = Application.Transpose(DestArray()) 'output
    
End Sub
Function CountIfArray(ARR(), vItem) As Long

    Dim X As Long
    Dim Y As Long
    
    CountIfArray = 0
    
    For X = LBound(ARR, 1) To UBound(ARR, 1)
        For Y = LBound(ARR, 2) To UBound(ARR, 2)
            If ARR(X, Y) = vItem Then
                CountIfArray = CountIfArray + 1
            End If
        Next Y
    Next X
    
End Function

Example of output:

Example using variable rowlimit:

Append Indexes in a Particular Way

Option Explicit

Sub AppendIndexes()
    
    ' Define constants.
    
    ' Source
    Const sName As String = "Sheet1"
    Const sFirstCellAddress As String = "B2"
    Const sRowLimitCellAddress As String = "D7"
    ' Destination
    Const dName As String = "Sheet1"
    Const dFirstCellAddress As String = "B16"
    Const dDelimiter As String = " "

    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source worksheet ('sws').
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    
    ' Attempt to store the row limit in a variable ('sRowLimit').
    Dim sRowLimit As Long
    On Error Resume Next
        sRowLimit = sws.Range(sRowLimitCellAddress).Value
    On Error GoTo 0
    
    ' Validate the row limit.
    If sRowLimit < 1 Then
        MsgBox "The row limit needs to be an integer greater than 0.", vbCritical
        Exit Sub
    End If
    
    ' Reference the first source cell ('sfCell').
    Dim sfCell As Range: Set sfCell = sws.Range(sFirstCellAddress)
    
    Dim srg As Range
    ' Reference the source (one-column) range ('srg').
    With sfCell.CurrentRegion.Columns(sfCell.Column)
        Set srg = sfCell.Resize(.Row + .Rows.Count - sfCell.Row)
    End With
    ' Note that there are many different ways to do it.
    ' To see if it is the correct range you can use e.g.:
    'Debug.Print srg.Address(0, 0)
    ' or:
    'MsgBox srg.Address(0, 0)
        
    ' Store the number of rows of the source range in a variable ('rCount').
    Dim rCount As Long: rCount = srg.Rows.Count
        
    Dim Data() As Variant
    ' Store the values from the source range
    ' in a 2D one-based one-column array, the data array ('Data').
    If rCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
    Else
        Data = srg.Value
    End If
    
    ' Define a new dictionary (dict).
    ' Its 'keys' will hold the unique strings from the source range.
    ' Its 'items' will hold the rows in the unique counts array.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' case-insensitive i.e. 'A = a'
    
    ' Define the unique counts array ('uCounts'), a 1D one-based array
    ' with the same number of rows as the number of rows in the data array,
    ' to hold the count of each unique string.
    Dim uCounts() As Long: ReDim uCounts(1 To rCount)
    ' The size of the array is probably too big but the 'mrCount' variable
    ' will determine the number of rows of interest, the mapping rows count.
    
    Dim r As Long ' Current Data Array Row
    Dim mr As Long ' Current Mapping Row
    Dim mrCount As Long ' Current and Final Mapping Rows Count
    Dim cString As String ' Current Data Array Value Converted to a String
    
    ' Loop through the rows of the data array...
    For r = 1 To rCount
        ' Retrieve the current value from the data array converted to a string.
        cString = CStr(Data(r, 1))
        ' Replace the value with the string.
        Data(r, 1) = cString
        ' Check if the string exists in the 'keys' of the dictionary.
        If Not dict.Exists(cString) Then
            mrCount = mrCount + 1 ' increment the mapping rows count...
            dict(cString) = mrCount ' ... and write it to the associated 'item'
            mr = mrCount ' retrieve the current mapping row
        Else
            mr = dict(cString) ' retrieve the current mapping row
        End If
        ' In the current mapping row of the unique counts array,
        ' increment the number by 1.
        uCounts(mr) = uCounts(mr) + 1
    Next r
    
    ' Define the unique indexes array ('uIndexes'), a 1D one-based array
    ' with the same number of rows as the mapping rows count ('mrCount'),
    ' to hold the current index.
    Dim uIndexes() As Long: ReDim uIndexes(1 To mrCount)
    
    ' Loop through the elements of the unique array and for each value
    ' greater than the row limit, write 1 to it.
    For mr = 1 To mrCount
        If uCounts(mr) > sRowLimit Then
            uIndexes(mr) = 1
        End If
    Next mr
    Erase uCounts
    
    ' Define the indexes counts array ('uIndexes'), a 1D one-based array
    ' with the same number of rows as the mapping rows count ('mrCount'),
    ' to hold the current indexes count, a number from 1 to the row limit.
    Dim iCounts() As Long: ReDim iCounts(1 To mrCount)
    
    Dim iCount As Long ' Current Index Count
    Dim uIndex As Long ' Current Unique Index
    
    ' Write the resulting strings to the data array.
    
    ' Loop through the rows of the data array.
    For r = 1 To rCount
        ' Retrieve the string from the current row of the data aray.
        cString = Data(r, 1)
        ' Retrieve the mapping row for the current string.
        mr = dict(cString)
        ' Retrieve the unique index for the current mapping row.
        uIndex = uIndexes(mr)
        If uIndex > 0 Then
            ' Increment the current index count by 1.
            iCount = iCounts(mr) + 1
            ' Check if the current index count is greater than the row limit.
            If iCount > sRowLimit Then ' it is greater
                iCount = 1 ' reset the current index count
                uIndex = uIndex + 1 ' increment the 'uIndex' by 1, and...
                uIndexes(mr) = uIndex ' ... write it to the unique indexes array
            'Else ' the current count is not greater than the row limit
            End If
            iCounts(mr) = iCount ' write the count to the indexes counts array
            ' Build and write the resulting string to the current row
            ' of the data array (overwriting the (previous) string).
            Data(r, 1) = cString & dDelimiter & CStr(uIndex)
        End If
    Next r
    Erase iCounts
    Erase uIndexes
    Set dict = Nothing
            
    ' Reference the destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    ' Reference the first destination cell ('dfCell').
    Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
    ' Reference the destination (one-column) range ('drg').
    Dim drg As Range: Set drg = dfCell.Resize(rCount)
    
    ' Write the strings from the data array to the destination range.
    drg.Value = Data
    ' Clear below.
    drg.Resize(dws.Rows.Count - drg.Row - rCount + 1).Offset(rCount).Clear

    ' Inform.
    MsgBox "Indexes appeded.", vbInformation

End Sub