-
1 Attachment(s)
Sort by String Length
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
Code:
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
-
The following will do the job - question crossposted at https://www.msofficeforums.com/word-...ng-length.html. Please cross post correctly.
Code:
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
-
-
