Sub CompactWordTables()
Dim c As Range, LastRw As Long, r As Range
With ActiveSheet
.Unprotect
.Columns("M").ClearContents
LastRw = .Range("B65536").End(xlUp).Row
For Each c In .Range("B1", "B" & LastRw)
If Not IsEmpty(c.Offset(0, 1)) Then
.Range("M" & c.Row).Value = c.Value
For Each r In .Range _
("C" & c.Row & ":K" & c.Row)
'may be needed
'R.MergeCells = False
If Not IsEmpty(r) Then
.Range("M" & r.Row).Value = _
.Range("M" & r.Row).Value & ", " & r.Value
End If
Next
End If
Next
End With
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Stuart" wrote in message
...
I have the following code:
Sub CompactWordTables()
Dim C As Range, LastRw As Long, R As Range
With ActiveSheet
.Unprotect
.Columns("M").ClearContents
LastRw = .Range("B65536").End(xlUp).Row
For Each C In .Range("B1", "B" & LastRw)
If Not IsEmpty(C.Offset(0, 1)) Then
For Each R In .Range _
("C" & C.Row, "K" & C.Row)
'may be needed
'R.MergeCells = False
If Not IsEmpty(R) Then
.Range("M" & R.Row).Value = _
C.Value & ", " & R.Value
End If
Next
End If
Next
End With
End Sub

This early code is designed to loop through a range in colB, testing the
adjacent cell in colC. If the colC cell is
not empty, then concatenate the values in that row
(cols C:K) and place the result in colM, where each
element is separated by ", ".

The code is not doing as I intended ...... for starters, it is
missing columns. In my test data, it picks up cols C and
E, but completely skips values in D.

What's my error please?

Regards.