Sort duplicates in the column

[topi1]

I need vba to sort rows based on a column as follows.
There are sets of duplicates in the column. Case-insensitive. There are blank cells in the column.
vba to sort so that the duplicates are in the adjacent rows, otherwise keeping their original order.
Remaining cells retain same order as before.
Thank you in advance.

 

[topi1]

Try this one:

Sub topi1_7()
Dim i As Long, n As Long, h As Long, k As Long
Dim va, vb
Dim d As Object, e As Object

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
Set e = CreateObject("scripting.dictionary"): e.CompareMode = vbTextCompare
n = Range("R" & Rows.Count).End(xlUp).Row
va = Range("O1:O" & n)
ReDim vb(1 To UBound(va, 1), 1 To 1)
n = 0
For i = 1 To UBound(va, 1)
    If va(i, 1) = "" Then
        n = n + 1
        vb(i, 1) = n
    Else
        If Not d.Exists(va(i, 1)) Then
            n = n + 1
            d(va(i, 1)) = n
            vb(i, 1) = n
        Else
            vb(i, 1) = d(va(i, 1))
            e(va(i, 1)) = ""
        End If
    End If
Next
h = e.Count
For i = 1 To UBound(va, 1)
    If e.Count = 0 Then Exit For
    If e.Exists(va(i, 1)) Then
        vb(i, 1) = ""
        e.Remove va(i, 1)
    End If
Next

'using col T as temporary helper column
Range("T1").Resize(UBound(vb, 1), 1) = vb
Range("A:T").Sort Key1:=Range("T1"), Order1:=xlAscending, Header:=xlNo
k = Range("T" & Rows.Count).End(xlUp).Row
Cells(k + 1, 1).Resize(h).EntireRow.ClearContents
Range("T:T").ClearContents
End Sub

@Akuini Perfect. Thank you so much. I really appreciate your time, patience and help.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.