How to autofit text containing CHR(10)?

[Joe User]

The macro below produces the desired result when "multirow" is false. That
is, columns are appropriately autofit'd.

But autofit does not seem to work when "multirow" is true; that is, when the
text contains explicit newlines (Chr(10)).

How can I effectively autofit when "multirow" is true?

(And "kludge1fit" and "kludge2fit" are false.)

I tried a couple kludges. Each has their own weaknesses.

I prefer the "kludge2fit" kludge; that is, setting the column width at the
end based on the longest line created. In actual practice, the length of
the longest line is derived during a loop, based on data from an external
file. I do not have any idea a priori how long that might be.

But as I understand ColumnWidth, setting it to the number of characters
might not work in some corner cases. I'm not sure what the "Normal style"
is (default font?); but in any case, it might not be the same as the font
for particular cells. Also, I'm not sure if "0" is the widest character in
all proportional fonts. I would guess that "w" is.

In any case, "kludge2fit" does not work well because RowHeight is changed
implicitly in the interim. I do not know how to effectively "autofit"
RowHeight afterwards. How could I do that?

The "kludge1fit" kludge works better (with "kludge2fit" = False). It avoids
the RowHeight problem. But the choice of ColumnWidth (100) is arbitrary.
Also, this suffers the same hypothetical weaknesses regarding the default
font and widest character.

I am using Excel 2003 (SP3) with VBA 6.5.1024.

The macro (for demonstration purposes)....


Option Explicit
#Const multirow = True
#Const kludge1fit = False
#Const kludge2fit = False

Private Sub doit()
Const cellName As String = "B2"
Const nRow As Long = 3
Const nCol As Long = 3
Dim r As Long, c As Long, i As Long, t As String, s As String
Dim maxLen As Integer, x As Long

Range("a:z").Delete
Range("a1").Select

#If kludge1fit And Not kludge2fit Then
'set ColumnWidth before storing text
Range(cellName).Resize(1, nCol).ColumnWidth = 100
#End If

For r = 1 To nRow: For c = 1 To nCol
t = String(r * c, "x")
s = "morelongtext1" & t
#If multirow Then
For i = 2 To r * c
s = s & Chr(10) & "morelongtext" & String(i, 48 + i) & t
Next i
#End If
Range(cellName).Cells(r, c) = s
Next c: Next r

#If kludge2fit Then
'set ColumnWidth after storing text
x = nRow * nCol
maxLen = Len("morelongtext" & String(x, 48 + x) & t)
Range(cellName).Resize(nRow, nCol).ColumnWidth = maxLen
#End If

Range(cellName).Resize(nRow, nCol).Columns.AutoFit
End Sub

 

[Mishell]

Range("A1").WrapText = True
Range("A1").Rows.AutoFit

Mishell

 

[Joe User]

Multirow only applies the controls and not the worksheet.
Use wrap text to the worksheet.
Range("A1").WrapText = True

I had high hopes for this suggestion because it rang true.

But setting WrapText did nothing.

On the off-chance I did something wrong, see the complete modified macro
below. If you have a correction, please snip and correct the lines from the
macro to be specific. And please test your suggestion. I couldn't have
made it any easier to do.

I tried setting WrapText a few different ways separately. Again, none
worked for me.

First, after the loop (my preference):

Range(cellName).Resize(1, nCol).Columns.WrapText = True
Range(cellName).Resize(1, nCol).Columns.AutoFit

Note: I also altered the AutoFit line, changing Resize(nRow,nCol) to
Resize(1,nCol). I think the latter is sufficient. But I tried it both
ways, to no avail.

Alternatively, in the loop:

Range(cellName).Cells(r, c).WrapText = True
Range(cellName).Cells(r, c) = s

Finally, alternatively, in the loop:

Range(cellName).Cells(r, c).NumberFormat = "@"
Range(cellName).Cells(r, c).WrapText = True
Range(cellName).Cells(r, c) = s


The modified macro....


Option Explicit
#Const multirow = True
#Const kludge1fit = False
#Const kludge2fit = False

Private Sub doit()
Const cellName As String = "B2"
Const nRow As Long = 3
Const nCol As Long = 3
Dim r As Long, c As Long, i As Long, t As String, s As String
Dim maxLen As Integer, x As Long

Range("a:z").Delete
Range("a1").Select

#If kludge1fit And Not kludge2fit Then
'set ColumnWidth before storing text
Range(cellName).Resize(1, nCol).ColumnWidth = 100
#End If

For r = 1 To nRow: For c = 1 To nCol
t = String(r * c, "x")
s = "morelongtext1" & t
#If multirow Then
For i = 2 To r * c
s = s & Chr(10) & "morelongtext" & String(i, 48 + i) & t
Next i
#End If
Range(cellName).Cells(r, c).NumberFormat = "@" 'workaround
Range(cellName).Cells(r, c).WrapText = True 'workaround
Range(cellName).Cells(r, c) = s
Next c: Next r

#If kludge2fit Then
'set ColumnWidth after storing text
x = nRow * nCol
maxLen = Len("morelongtext" & String(x, 48 + x) & t)
Range(cellName).Resize(1, nCol).ColumnWidth = maxLen
#End If

Range(cellName).Resize(1, nCol).Columns.AutoFit
End Sub