如何按文本对列进行排序？当前代码有问题

Question

有报告，我需要对按指定列排序的相似值进行分组，然后重新填充列表。

Private Sub CommandButton1_Click()
Dim myRange As Range
Dim rowCount As Integer, currentRow As Integer
Dim firstBlankRow As Integer, lastBlankRow As Integer
Dim currentRowValue As String

'select range based on given named range
Set myRange = Range("D2:D1000")
rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

firstBlankRow = 0
lastBlankRow = 0
'for every row in the range
For currentRow = 1 To rowCount
    currentRowValue = Cells(currentRow, myRange.Column).Value

    If (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        'if cell is blank and firstBlankRow hasn't been assigned yet
        If firstBlankRow = 0 Then
            firstBlankRow = currentRow
        End If
    ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        If firstBlankRow <> 0 Then
            'if firstBlankRow is assigned and this row has a value
            'then the cell one row above this one is to be considered
            'the lastBlankRow to include in the grouping
            lastBlankRow = currentRow - 1
        End If
    End If

    'if first AND last blank rows have been assigned, then create a group
    'then reset the first/lastBlankRow values to 0 and begin searching for next
    'grouping
    If firstBlankRow <> 0 And lastBlankRow <> 0 Then
        Range(Cells(firstBlankRow, myRange.Column), Cells(lastBlankRow, myRange.Column)).EntireRow.Select
        Selection.Group
        firstBlankRow = 0
        lastBlankRow = 0
    End If
Next
End Sub