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.

 

[Joe4]

In situations like this, it is often best to show us an example (a picture says 1000 words!).
Please post some sample data and your expected results.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[topi1]

Sorry about that. Here are examples of pre and post (desired results). Thank you in advance.

PRE

Book1
	A	B
1	B	1
2	A	2
3	C	3
4	A	4
5	A	5
6	B	6
7	C	7
8	D	8
9	A	9
10	D	10
Sheet1

POST (EXPECTED)

Book1
	A	B
1	B	1
2	B	6
3	A	2
4	A	4
5	A	5
6	A	9
7	C	3
8	C	7
9	D	8
10	D	10
Sheet1

 

[Akuini]

Try this:
I'm using col C as temporary helper column.

Sub topi1_1()
Dim i As Long, n As Long
Dim va, vb
Dim d As Object

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
va = Range("A1", Cells(Rows.Count, "A").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    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))
    End If
Next

'using col C as temporary helper column
Range("C1").Resize(UBound(vb, 1), 1) = vb
Range("A:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlNo
Range("C:C").ClearContents
End Sub

 

[topi1]

Try this:
I'm using col C as temporary helper column.

Sub topi1_1()
Dim i As Long, n As Long
Dim va, vb
Dim d As Object

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
va = Range("A1", Cells(Rows.Count, "A").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    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))
    End If
Next

'using col C as temporary helper column
Range("C1").Resize(UBound(vb, 1), 1) = vb
Range("A:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlNo
Range("C:C").ClearContents
End Sub

@Akuini Brilliant. Thank you so much for your prompt help.

 

[topi1]

@Akuini is it possible to extend the vba (or have a separate vba) which removes top row of all duplicates? Here is the example from above.

The results from the initial VBA is as follows:

Book1
	A	B
1	B	1
2	B	6
3	A	2
4	A	4
5	A	5
6	A	9
7	C	3
8	C	7
9	D	8
10	D	10
Sheet1

Desired results about additional vba or modified vba:

Book1
	A	B
1	B	6
2	A	4
3	A	5
4	A	9
5	C	7
6	D	10
Sheet1 (3)

 

[Akuini]

is it possible to extend the vba (or have a separate vba) which removes top row of all duplicates?

Is there any items that has no duplicate? Like this:

Book2
	A	B
1	B	1
2	A	2
3	X	3
4	A	4
5	A	5
6	B	6
7	C	7
8	D	8
9	A	9
10	D	10
Sheet3

If so, you want to keep it?

 

[topi1]

Yes. There are items without duplicates. I need to keep them. TY.

 

[Akuini]

Try this:

Sub topi1_2()
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
k = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A1:A" & k)
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    If Not d.Exists(va(i, 1)) Then
        n = n + 1
        d(va(i, 1)) = n
        vb(i, 1) = i
    Else
        vb(i, 1) = d(va(i, 1))
        e(va(i, 1)) = ""
    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 C as temporary helper column
Range("C1").Resize(UBound(vb, 1), 1) = vb
Range("A:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlNo
k = Range("C" & Rows.Count).End(xlUp).Row
Cells(k + 1, 1).Resize(h, 2).ClearContents
Range("C:C").ClearContents
End Sub

 

[topi1]

@Akuini Thank you.

I thought the results will be as follows.

Book1
	D	E
46	B	6
47	A	4
48	A	5
49	A	9
50	X	3
51	C	7
52	D	10
Sheet1 (5)

Instead I get the following:

Book1
	A	B
1	B	6
2	A	4
3	A	5
4	A	9
5	X	3
6	D	10
7	C	7
Sheet1 (5)