CODEWITHSUNDEEP
vbams-wordselectionskip
Anthony Lang
Anthony Lang

Reputation: 1

VBA loop through table to sort content of each cell selects entire table

I have a single column table of several hundred cells in Word (actually a copy paste from Excel). I want to alphabetize the content of each cell using a VBA script to loop through the table. Here is a sample extract from the table:

Sample Table with formatting shown:
enter image description here

Text content of each cell:

Cell1:

TM-102
Software V&V Summary
TM-044
Risk Management File RMF151
TM-081
TR-379

Cell2: [empty - only the End of Cell mark present]

Cell3:

T-021
TR-1508
TR-1687
Environmental Footprint Analysis - TR-517 
TM-044
Cytotoxicity Study Using the ISO Elution Method (1X MEM Extract) - TM-081
ISO Intracutaneous Study Extract - TM-102
Risk Management File RMF151 - All risks were mitigated to an acceptable level

Cell4:

Rest of World
Brazil
TÜV 19.1833
China
Certificate # 20162543150
Software V&V Summary
Risk Management File RMF151 - All risks were mitigated to an acceptable level.
TEST REPORT
Rest of World
Brazil
China
elements of the alarm systems for expected and unexpected alarm events.
Software V&V Summary

This is the code I have written (not elegant but doesn't have to be):

Sub Sort_cell()
'
' Sort_cell Macro
'
'
    Dim count As Integer
    Dim iteration As Integer
    iteration = 0
        
    count = ActiveDocument.Tables(1).Rows.count
    
    If Selection.Information(wdWithInTable) Then
        Selection.Tables(1).Range.Select
        Selection.Collapse 1
    End If
    
    On Error Resume Next
    
    While Selection.Information(wdWithInTable)
        iteration = iteration + 1
        Selection.Expand unit:=wdCell
        Selection.MoveEnd unit:=wdCharacter, count:=-1
        Selection.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
        SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
        FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
        wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
        wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
        wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
        :=wdEnglishUS, SubFieldNumber:="Paragraphs", SubFieldNumber2:= _
        "Paragraphs", SubFieldNumber3:="Paragraphs"
        Selection.MoveRight unit:=wdCell, count:=1, Extend:=wdMove
                    
        If iteration = count Then
            Exit Sub
        End If
    Wend

End Sub

What is happening is that the loop hits Cell 2 which is empty and the Selection.MoveRight command selects the entire table at which point the macro loops back to the top and starts again. I want the code, if it encounters an empty cell, to just skip past it to the next one.

Upvotes: 0

Views: 42

Answers (1)

Tim Williams
Tim Williams

Reputation: 166755

This seems to work for me.

Sub Tester()
    
    Dim tbl As Table, c As Cell, r As Row, rng As Range
    
    If Not Selection.Information(wdWithInTable) Then Exit Sub
    
    Set tbl = Selection.Tables(1)
    For Each r In tbl.Rows                    'loop over table rows
        For Each c In r.Cells                 '...and the cells in each row
            If Len(c.Range.Text) > 3 Then     'anything to sort?
                Set rng = c.Range             'cell content
                rng.MoveEnd wdCharacter, -2   'exclude "end of cell" marker
                rng.Sort excludeheader:=False 'perform sort
            End If
        Next c
    Next r
End Sub

Upvotes: 2

Related Questions