excel 2016 wrap text problem

[xenios]

Hi All!
Searching all over the internet it seems the problem can't be solved, as it is just like that. But may be someone still can find a solution.
In workbook, several sheets ( a lot of sheets) have free text with merged cells ( columns) and not all the text is visible. ( attached). Autofit cell height is not working.
Example of the file here test.xlsx

So far the only solution was to drag the cell down until everything is visible manually.
Rows are always different. Column starts from A
Sometimes there's so much text that have to merge rows also manually to fit it.

May still there's way around doing it all by hand?
Thank you!

 

[xenios]

Did you double click the row height line between rows 82 and 83 afterwards?
The height adjustment is not automatic as soon as you apply the format change, you still need to double click to autofit.

Also, see the link in post 7. Do you think it is something that you could use?

Sub MergedAreaRowAutofit()
Dim j As Long
Dim n As Long
Dim i As Long
Dim MW As Double 'merge width
Dim RH As Double 'row height
Dim MaxRH As Double
Dim rngMArea As Range
Dim rng As Range

Const SpareCol As Long = 26
Set rng = Cells(Rows.Count, "A").End(xlUp)
Rows(rng.Row).WrapText = True

With rng
For j = 1 To .Rows.Count
'if the row is not hidden
If Not .Parent.Rows(.Cells(j, 1).Row) _
.Hidden Then
'if the cells have data
If Application.WorksheetFunction _
.CountA(.Rows(j)) Then
MaxRH = 0
For n = .Columns.Count To 1 Step -1
If Len(.Cells(j, n).Value) Then
'mergecells
If .Cells(j, n).MergeCells Then
Set rngMArea = _
.Cells(j, n).MergeArea
With rngMArea
MW = 0
If .WrapText Then
'get the total width
For i = 1 To .Cells.Count
MW = MW + _
.Columns(i).ColumnWidth
Next
MW = MW + .Cells.Count * 0.66
'use the spare column
'and put the value,
'make autofit,
'get the row height
With .Parent.Cells(.Row, SpareCol)
.Value = rngMArea.Value
.ColumnWidth = MW
.WrapText = True
.EntireRow.AutoFit
RH = .RowHeight
MaxRH = Application.Max(RH, MaxRH)
.Value = vbNullString
.WrapText = False
.ColumnWidth = 8.43
End With
.RowHeight = MaxRH
End If
End With
ElseIf .Cells(j, n).WrapText Then
RH = .Cells(j, n).RowHeight
.Cells(j, n).EntireRow.AutoFit
If .Cells(j, n).RowHeight < RH Then _
.Cells(j, n).RowHeight = RH
End If
End If
Next
End If
End If
Next
.Parent.Parent.Worksheets(.Parent.Name).UsedRange
End With
End Sub

This one works fine if I delete everything and leave only the text that would start from A1

Otherwise didn't manage to make t to work.

The las one that @jann6628
said it's finally working, didn't manage to make it work, had errors all the time.

 

[jasonb75]

I tried the code from that thread and found errors as well, I think that there is a maximum height / width that the code will work with and that your data is exceeding that limit.

I tried a simple approach to the task which appears to work, this will resize the last non empty cell with text in column A. This is manually run code for testing, but could be set to a worksheet change event if needed.

Option Explicit
Sub xenios_test()
Application.ScreenUpdating = False
Dim ColWidthA As Double, c As Range, MCell As Range
Set c = Cells(Rows.Count, 1).End(xlUp)
Set MCell = c.MergeArea
ColWidthA = Range("A:A").ColumnWidth
MCell.UnMerge
Columns("A:A").ColumnWidth = 200
c.EntireRow.AutoFit
MCell.Merge
Columns("A:A").ColumnWidth = ColWidthA
Application.ScreenUpdating = True
End Sub

 

[xenios]

Did you double click the row height line between rows 82 and 83 afterwards?
The height adjustment is not automatic as soon as you apply the format change, you still need to double click to autofit.

Also, see the link in post 7. Do you think it is something that you could use?

I tried the code from that thread and found errors as well, I think that there is a maximum height / width that the code will work with and that your data is exceeding that limit.

I tried a simple approach to the task which appears to work, this will resize the last non empty cell with text in column A. This is manually run code for testing, but could be set to a worksheet change event if needed.

Option Explicit
Sub xenios_test()
Application.ScreenUpdating = False
Dim ColWidthA As Double, c As Range, MCell As Range
Set c = Cells(Rows.Count, 1).End(xlUp)
Set MCell = c.MergeArea
ColWidthA = Range("A:A").ColumnWidth
MCell.UnMerge
Columns("A:A").ColumnWidth = 200
c.EntireRow.AutoFit
MCell.Merge
Columns("A:A").ColumnWidth = ColWidthA
Application.ScreenUpdating = True
End Sub

Yes, it works perfectly!! Just need it to work for the whole workbook.

 

[jasonb75]

You mean something like

Option Explicit
Sub xenios_test()
Application.ScreenUpdating = False
Dim ColWidthA As Double, c As Range, MCell As Range, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
        Set c = .Cells(.Rows.Count, 1).End(xlUp)
        Set MCell = c.MergeArea
        ColWidthA = .Range("A:A").ColumnWidth
        MCell.UnMerge
        .Columns("A:A").ColumnWidth = 200
        c.EntireRow.AutoFit
        MCell.Merge
        .Columns("A:A").ColumnWidth = ColWidthA
    End With
Next ws
Application.ScreenUpdating = True
End Sub

I haven't tested that, hopefully there will be no unexpected errors.

 

[xenios]

You mean something like

Option Explicit
Sub xenios_test()
Application.ScreenUpdating = False
Dim ColWidthA As Double, c As Range, MCell As Range, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
        Set c = .Cells(.Rows.Count, 1).End(xlUp)
        Set MCell = c.MergeArea
        ColWidthA = .Range("A:A").ColumnWidth
        MCell.UnMerge
        .Columns("A:A").ColumnWidth = 200
        c.EntireRow.AutoFit
        MCell.Merge
        .Columns("A:A").ColumnWidth = ColWidthA
    End With
Next ws
Application.ScreenUpdating = True
End Sub

I haven't tested that, hopefully there will be no unexpected errors.

It works fine
Is there a chance to make it to merge also the next row in case the text is too long and doesn't fit into one?
Sorry to be pain

 

[jasonb75]

Is there a chance to make it to merge also the next row in case the text is too long and doesn't fit into one?

If the text is too long for it to fit then merging the next row will not help. The entire merged range has the same character limit as a single cell.

 

[xenios]

If the text is too long for it to fit then merging the next row will not help. The entire merged range has the same character limit as a single cell.

ok will do it manually.

Thank you for the rest!!!

 

[jasonb75]

ok will do it manually.

I can't see how that will help, the same limits would still apply.

There might be something else to it but without seeing a copy of the sheet where you think that it need another row, I can do nothing more than guess.

 

[xenios]

I can't see how that will help, the same limits would still apply.

There might be something else to it but without seeing a copy of the sheet where you think that it need another row, I can do nothing more than guess.

Manually it works. Here is the link test.xlsx
1st sheet is how it is by default and the 2nd fixed manually.

 

[jasonb75]

I don't think that you will have to do manual with anything like that, the number of lines of text in the cell exceeds the number of lines of text that will fit on the screen. The maximum height for autofit can not be taller than the screen.

It might work by reducing the zoom level to make it fit on the screen, I'll have a go at that later and see what happens.