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

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.