Macro to Highlight Duplicates and add Duplicate text at a column

Hi,

I have a excel will below data, it will identify the set of repeated numbers and seperate a line on each set. That is working fine so far, but i need to add one more Inputbox and allow user enter the column to check for duplicates.
So that i will check for duplicates in each set and highlight with color and add text "duplicate" at last column.

Data:

13 D29
13 D29
13 D3
14 D3
14 D85
15 D78
15 D78
15 D78

It will identify 13 as on set and add a new empty line and similar to 14 and 15 as below.

13 D29
13 D29
13 D3

14 D3
14 D85

15 D78
15 D78
15 D78

Now it has to identify duplicates in each set and highlight and add duplicate text.

13 D29
13 D29 Duplicate
13 D3

14 D3
14 D85

15 D78
15 D78 Duplicate
15 D78 Duplicate

Below is the code i tried..

 Dim iCol As Integer
Dim irownum As Integer
Dim iBlankCount As Integer
Dim sLastData As String
Dim iSetCount As Integer
Dim FirstItem As String
Dim SecondItem As String
Dim Offsetcount As Integer


Const BLANK_EOF = 100

Application.ScreenUpdating = False

irownum = InputBox(Worksheets(1).Name & " will be used.  Enter starting row: ")
iCol = LetterToCol(InputBox("Enter column LETTER that defines each set"))
iBlankCount = 0
iSetCount = 0
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
Offsetcount = 1
   
Do While iBlankCount <= BLANK_EOF
    If Trim(Worksheets(1).Cells(irownum, iCol).Value) = "" Then
        iBlankCount = iBlankCount + 1
    Else
        iBlankCount = 0
        If sLastData <> Trim(Worksheets(1).Cells(irownum, iCol).Value) Then
            If sLastData <> "" Then
                Worksheets(1).Rows(irownum).Select
                Selection.Rows.EntireRow.Insert
               ' Worksheet(1).Rows(irownum).EntireRow.Insert
                sLastData = Trim(Worksheets(1).Cells(irownum, iCol).Value)
                iSetCount = iSetCount + 1
               
            Else
                sLastData = Trim(Worksheets(1).Cells(irownum, iCol).Value)
            End If
            
        End If
    End If
    irownum = irownum + 1
    
Loop

Do While iBlankCount <> ""
      If FirstItem = SecondItem Then
        ActiveCell.Offset(Offsetcount, 0).Interior.Color = RGB(255, 0, 0)
        Offsetcount = Offsetcount + 1
        SecondItem = ActiveCell.Offset(Offsetcount, 0).Value
      Else
        ActiveCell.Offset(Offsetcount, 0).Select
        FirstItem = ActiveCell.Value
        SecondItem = ActiveCell.Offset(1, 0).Value
        Offsetcount = 1
      End If
   Loop

Application.ScreenUpdating = True
MsgBox ("Number of sets: " & iSetCount + 1)


End Sub

I am not able to identify duplicates and highlight. Can someone please help..?

Thanks
Sanjay

Try this

Sub test()
    Dim r As Range, myArea As Range, e
    On Error Resume Next
    Set r = Application.InputBox("Select starting cell", Type:=8)
    On Error GoTo 0
    If r Is Nothing Then Exit Sub
    With Range(r, Cells(Rows.Count, r.Column).End(xlUp)).SpecialCells(2)
        .Font.ColorIndex = xlAutomatic
        For Each myArea In .Areas
            If myArea.Count > 1 Then
                For Each e In Filter(myArea.Parent.Evaluate("transpose(if(countif(offset(" & myArea.Address & _
                        ",,,row(1:" & myArea.Rows.Count & "))," & myArea.Address & ")>1,row(1:" & myArea.Count & ")))"), False, 0)
                    myArea(e).Font.Color = vbRed
                Next
            End If
        Next
    End With
End Sub