You can take care of the increased row height of the original cell by
simply setting that row height back to 12.75 or removing the wrap format.
Yes, I had just noticed that problem.
For me, .Columns(2).WrapText = False
seems the solution.
Good to see Dick's suggestion gave you improvements too.
Regards.
"Otto Moehrbach" wrote in message
...
Stuart
I redid my macro to incorporate Dick's suggestion. I don't have a
wrapped cell so I didn't use the row height as Dick suggested.
I saw a need to include a couple of error traps. One is if the active
cell is blank (the user forgot to select the 'long' cell before he ran the
macro). The other is if the active cell entry is not longer than the cell
is wide (the result of the 'Justify' action is one row). Both of these
conditions will result in an error without the error traps.
You can take care of the increased row height of the original cell by
simply setting that row height back to 12.75 or removing the wrap format.
Dick's suggestion made my macro a lot simpler. Thanks Dick. Otto
Sub LongCellFix()
Dim OriginalCell As Range
Dim TempCell As Range
Dim RowsReqd As Long
Application.ScreenUpdating = False
If ActiveCell = "" Then
MsgBox "The selected cell is blank."
Exit Sub
End If
Set OriginalCell = Range(ActiveCell.Address)
Set TempCell = Cells(Rows.Count, OriginalCell.Column).End(xlUp)(2)
TempCell.Value = OriginalCell.Value
Application.DisplayAlerts = False
TempCell.Justify
Application.DisplayAlerts = True
RowsReqd = Range(TempCell.Address, Cells(Rows.Count,
TempCell.Column).End(xlUp)).Rows.Count
If RowsReqd = 1 Then
MsgBox "The entry is not longer than the column width."
TempCell.ClearContents
Exit Sub
End If
OriginalCell(2).Resize(RowsReqd - 1).EntireRow.Insert
Range(TempCell.Address, Range(TempCell.Address).End(xlDown)).Cut
OriginalCell
Application.ScreenUpdating = True
End Sub
"Stuart" wrote in message
...
Many thanks. I'll give it a try. Dick's suggestion
might help us both?
Regards.
"Otto Moehrbach" wrote in message
...
There is no built-in way to do that in Excel. You would have to 'roll
your
own' in this case. I often need to do what you describe so I wrote a
macro
to do it for me. This macro takes whatever is in the active cell,
assuming
the entry is longer than the cell is wide, and inserts the necessary
blank
rows below that cell and cuts and pastes the cell entry to occupy as
many
rows, as wide as the cell, as it takes.
This macro is not refined and it doesn't do the job perfectly
every
time. Also, it will handle upper case differently than lower case,
and
you
will need to adjust the constants to work with your font. But for me
it
does the job. HTH Otto
Sub LongCellFix()
Dim Co As Integer
Dim FirstPart As String, TheRest As String
Dim Space As Integer, Cou As Integer, i As Range
Dim CutOff As Integer
CutOff = Int(ActiveCell.ColumnWidth * 1.28)
ActiveCell.Value = Trim(ActiveCell.Value)
Set i = ActiveCell
For Cou = 1 To 300
If Len(i) < CutOff + 1 Then Exit For
For Co = 0 To 50
If Mid(i, CutOff - Co, 1) = " " Then Exit For
Next
Space = CutOff - Co
FirstPart = Trim(Left(i, Space))
TheRest = Trim(Right(i, Len(i) - Space))
If Not i.Offset(1).Value = "" Then
i.Offset(1, 0).Rows("1:1").EntireRow. _
Insert Shift:=xlDown
i.Value = FirstPart
i.Offset(1).Value = TheRest
Set i = i.Offset(1)
ActiveCell.Select
Next
End Sub
"Stuart" wrote in message
...
Say I paste text data (essentially a sentance(s) ) into B2,
where Col B has a columnwidth of 55 and the RowHeight
is set to 12.75.
I then enable Wraptext in this cell, and the RowHeight now
increases to 51 (so the data is occupying 3 + lines in the
cell).
I save the workbook, close it, then reopen it.
Is there a way to reformat the data in B2, so that it will
then occupy 4no 12.75 high rows in colB?
I believe the data will only be space delimited.
Regards.
---
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
---
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
---
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