Move data in row in a Microsoft Word Table

Mattie Owens
Mattie Owens used Ask the Experts™
on
Is it possible to move a cell value to the previous cell if the previous cell is empty using VBA

Want no blank cells in table

Blank  TEXT Blank TEXT

to be


TEXT TEXT
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Ryan ChongSoftware Team Lead

Commented:
try something like this:

Sub test()
    Dim RowNum As Integer, LastCol As Integer, Arr() As String, currentIdx As Integer
    RowNum = 1
    currentIdx = 1
    
    LastCol = ActiveSheet.Cells(RowNum, ActiveSheet.Columns.Count).End(xlToLeft).Column
    For i = 1 To LastCol
        ReDim Preserve Arr(i - 1)
        Arr(i - 1) = Cells(RowNum, i)
        Debug.Print i & " = " & Cells(RowNum, i)
    Next
    
    For i = 0 To UBound(Arr)
        If Trim(Arr(i)) <> "" Then
            Cells(RowNum, currentIdx) = Arr(i)
            currentIdx = currentIdx + 1
        End If
    Next
    
    For i = currentIdx To UBound(Arr) + 1
        Cells(RowNum, i) = ""
    Next
End Sub

Open in new window

29152204.xlsm

Author

Commented:
I should have clarified that it was a word table. But, the information is definitely helpful.
GrahamSkanRetired
Top Expert 2012

Commented:
If you do need it for Word, perhaps this will do.
Each row is treated individually. The data is copied from the previous cell in the row. Warning text is generated if the first cell is empty.
Sub BlankFill()
    Dim tbl As Table
    Dim rw As Row
    Dim cl As Cell
    Dim rng As Range
    Dim strPrevious As String
    
    Set tbl = ActiveDocument.Tables(1)
    
    For Each rw In tbl.Rows
        strPrevious = "No Data"
        For Each cl In rw.Cells
            Set rng = cl.Range
            rng.MoveEnd wdCharacter, -1
            If rng.Text = "" Then
                rng.Text = strPrevious
            Else
                strPrevious = rng.Text
            End If
        Next cl
    Next rw
End Sub

Open in new window

Introduction to Web Design

Develop a strong foundation and understanding of web design by learning HTML, CSS, and additional tools to help you develop your own website.

Author

Commented:
this is the result of the script you provided.

CONCLUSION      CONCLUSION      Anti-D      Anti-E      Anti-E      Anti-E      Anti-E      Anti-E
Conclusion      Conclusion      Conclusion      Conclusion      Conclusion      Conclusion      Conclusion      Conclusion
Conclusion      Conclusion      Conclusion      Conclusion      Conclusion      Conclusion      Conclusion      Conclusion

I'm attaching a sample of what I would like it to accompish.
Sample-7-17.docm

Author

Commented:
Any thoughts?
Software Team Lead
Commented:
try customize this:

Sub BlankFill()
    Dim tbl As Table
    Dim rw As Row
    Dim cl As Cell
    Dim rng As Range
    Dim Arr() As String, startRow As Integer, cnt As Integer, runningCnt As Integer
    
    cnt = 0
    runningCnt = 0
    
    'Set for Table 1
    Set tbl = ActiveDocument.Tables(1)
    
    'Load the content into Array
    For Each rw In tbl.Rows
        If rw.Cells(1).Range.Text Like "CONCLUSION*" Or startRow > 0 Then
            'Set the start row, only once
            If startRow = 0 Then
                startRow = rw.Index
            End If
            
            For i = 2 To tbl.Columns.Count
                'compare cell value
                If Replace(Replace(rw.Cells(i).Range.Text, Chr(13), ""), Chr(7), "") <> "" Then
                    ReDim Preserve Arr(cnt)
                    Arr(cnt) = rw.Cells(i).Range.Text
                    cnt = cnt + 1
                End If
            Next
        End If
    Next rw
    
    'Re-populate the data
    For i = startRow To tbl.Rows.Count
        For j = 2 To tbl.Columns.Count
            If runningCnt > UBound(Arr) Then
                tbl.Rows(i).Cells(j).Range.Text = ""
            Else
                tbl.Rows(i).Cells(j).Range.Text = Arr(runningCnt)
                runningCnt = runningCnt + 1
            End If
        Next
    Next
End Sub

Open in new window

Author

Commented:
They both gave me insight to figure some things out. However; Ryan's solution worked the best for me. Great thanks

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial