Sort by String Length

[nmkhan3010]

Hi,


SORT BY STRING LENGTH


Here I want to sort by column no 3 but first 2 rows were not having the same columns and getting error "Invalid column number", can anyone alter the below code according to my need. (selection table range should be from row no. 3)


Below code has to exclude the first 2 rows and it should be consider from 3rd row because from third row it has a uniformity columns...

Table selection range should be from row no 3

Please anyone do the needful....


Below code source : 2 Smart Ways to Sort a Column of Texts by Length in Your Word - Data Recovery Blog

Sub SortByWordLength()
Dim objTable As Table
Dim objColumnCell As Cell
Dim objColumnCellRange As Range
Dim objNewColumnCellRange As Range
Dim nRowNumber As Integer
Dim nColumnNumber As Integer
Dim strWordLenth As String
Dim nSortOrder As Integer
Dim nCurrentTableIndex As Integer
Dim nTableColumnsInCurrentTable As Integer


nCurrentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
nTableColumns = ActiveDocument.Tables(nCurrentTableIndex).Columns. Count


nColumnNumber = InputBox("Enter the column number you want to sort", "Column Number", "For example:2")


If nColumnNumber > 0 And nColumnNumber <= nTableColumns Then
nSortOrder = InputBox("Choose the sort order:" & vbNewLine & "If you want to sort by descending, click 1" & vbNewLine & "If you want to sort by ascending, click 0", "Sort Order", "For example:1")


If nSortOrder = 1 Or nSortOrder = 0 Then
' Add a new column to put the word length of the specified column.
Set objTable = ActiveDocument.Tables(nCurrentTableIndex)
objTable.Columns.Add BeforeColumn:=objTable.Columns(nColumnNumber)
nRowNumber = 1


For Each objColumnCell In objTable.Columns(nColumnNumber + 1).Cells
Set objColumnCellRange = objColumnCell.Range
objColumnCellRange.MoveEnd Unit:=wdCharacter, Count:=-1
Set objNewColumnCellRange = objTable.Cell(nRowNumber, nColumnNumber).Range
objNewColumnCellRange.MoveEnd Unit:=wdCharacter, Count:=-1


strWordLenth = Len(objColumnCellRange.Text)


objNewColumnCellRange.InsertAfter (strWordLenth)


nRowNumber = nRowNumber + 1
Next objColumnCell


objTable.Select


' Sort by the word length.
Selection.Sort ExcludeHeader:=True, FieldNumber:="Column " & nColumnNumber, SortFieldType:= _
wdSortFieldNumeric, SortOrder:=nSortOrder, FieldNumber2:="", _
SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:=wdSortOrderAscending _
, FieldNumber3:="", SortFieldType3:=wdSortFieldAlphanumeric, SortOrder3:= _
wdSortOrderAscending, Separator:=wdSortSeparateByCommas, SortColumn:= _
False, CaseSensitive:=False, LanguageID:=wdEnglishUS, SubFieldNumber:= _
"Paragraphs", SubFieldNumber2:="Paragraphs", SubFieldNumber3:="Paragraphs"


objTable.Columns(nColumnNumber).Delete


Else
MsgBox ("Invalid sort type, please try again")
End If
Else
MsgBox ("Invalid column number, please try again")
End If
End Sub

[gmayor]

The following will do the job - question crossposted at https://www.msofficeforums.com/word-...ng-length.html. Please cross post correctly.

Sub Macro1()
'Graham Mayor - https://www.gmayor.com - Last updated - 02 Nov 2021
Dim oTable As Table
Dim oRow As Row
Dim oCell As Cell
Dim oRng As Range, oSplit As Range
Dim i As Integer
    If Selection.Information(wdWithInTable) = True Then
        Application.ScreenUpdating = False
        Set oTable = Selection.Tables(1)
        For i = oTable.Rows.Count To 4 Step -1
            Set oRow = oTable.Rows(i)
            Set oCell = oRow.Cells.Add
            Set oRng = oCell.Range
            oRng.End = oRng.End - 1
            oRng.Text = Len(oRow.Cells(3).Range) - 1
            If i = 4 Then
                oTable.Rows(i).Select
                Set oSplit = Selection.Range
                Selection.SplitTable
            End If
        Next i
        Set oTable = oSplit.Next.Tables(1)
        oTable.Sort ExcludeHeader:=False, FieldNumber:="Column 4", _
                    SortFieldType:=wdSortFieldNumeric, SortOrder:=wdSortOrderDescending
        oTable.Columns(4).Delete
        oSplit.Collapse 1
        oSplit.Delete
    Else
        MsgBox "Put the cursor in the table", vbCritical
    End If
    Application.ScreenUpdating = True
lbl_Exit:
    Set oSplit = Nothing
    Set oCell = Nothing
    Set oRow = Nothing
    Set oRng = Nothing
    Set oTable = Nothing
    Exit Sub
End Sub

[nmkhan3010]

Thanks a lot .....

[macropod]

Also cross-posted at: Sort by String Length (excelforum.com)
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3