Consulting

Results 1 to 4 of 4

Thread: Sort by String Length

  1. #1

    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


    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
    Attached Files Attached Files
    Last edited by macropod; 11-02-2021 at 07:53 PM.

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Thanks a lot .....

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,315
    Location
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •