View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Stuart[_5_] Stuart[_5_] is offline
external usenet poster
 
Posts: 413
Default divide multiline text cell across several rows

many thanks.

I'd achieved:

Sub SplitColBAcrossRows()
'The aim is to convert the wraptext cells in col B,
'such that each line of text occupies its' own row.

Dim ws As Worksheet, C As Range, i As Integer, rng As Range

For Each ws In ActiveWorkbook.Worksheets
With ws
.Unprotect
Set rng = .Columns(2).SpecialCells(xlConstants, xlTextValues)
' Set rng = .UsedRange.Columns(2).Cells
For Each C In rng

If C.RowHeight 12.75 Then
i = C.RowHeight / 12.75
For i = 1 To i - 1
C.Offset(1, 0).EntireRow.Insert Shift:=xlDown
C.Offset(1, 0).RowHeight = 12.75
Next
Application.DisplayAlerts = False
C.Justify
Application.DisplayAlerts = True
C.RowHeight = 12.75
End If
Next
End With
Next

End Sub

Regards.

"Dick Kusleika" wrote in message
...
Stuart

Many thanks. You understood.
Apologies I was not clear that a programmatical solution
was desired!


Well, you did post in .programming. I should have guessed.


However, following your suggestion I received this error:
"Text will extend beyond selected range" which could
potentially overwrite subsequent rows in the column?


You get that error message even if there's nothing to overwrite. You need
to set DisplayAlerts to False to avoid the message


However, I could first test for the rowheight of each cell,
divide by 12.75, then insert the required number of
additional rows.


That sounds like it would work. You could also just insert more than

enough
rows, then delete what you don't need.

Sub test()

Application.DisplayAlerts = False

With ActiveSheet
.Range("2:10").Insert 'insert too many rows
.Range("B1").Justify 'justify the text
.Range(.Range("B10").End(xlUp).Offset(1, 0), "b10").Delete 'delete

what
you don't need
End With

Application.DisplayAlerts = True

End Sub

--
Dick Kusleika
MVP - Excel
Excel Blog - Daily Dose of Excel
www.dicks-blog.com




---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.661 / Virus Database: 424 - Release Date: 19/04/2004