Wrap text in column headers to fit text in column

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hello,

I get about forty columns of data dumped into an Excel sheet every month.
The column headers at the top of the columns are usually considerably wider
than the data in the columns. I want to wrap the header text in each column
so that it is as wide as the widest entry in the rest of that column. Each
column width is diferent.

If anybody knows a quick method of doing this, it would save me a lot of time.
 
Maybe with a macro. Assuming your headers are in row 1:

Sub header()
Dim eCol As Integer
Dim i As Integer
Dim head As String
eCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To eCol
With Cells(1, i)
head = .Value
.ClearContents
.EntireColumn.AutoFit
.WrapText = True
.Value = head
End With
Next i
End Sub

Hope this helps
Rowan
 
Hello

Try this:

1) select the entire area except the heading row (i e typically row 2 and
downwards)

2) Format, Column, Autofit selection

3) select heading row (only)

4) Format, Cells, Alignment, Wrap text

Kind regards Marcus
 
Neat Rowan; Is there a way to "nudge-up" the spacing
a few more characters "above the standard "autofit amt?
If so, how?
TIA,
 
You may want to consider using alt-enter to force new lines within the cell.
Then you'll be able to break each header line where you want it.
 
You can look and just adjust.

With ActiveCell.EntireRow
MsgBox .RowHeight & " -- before"
.RowHeight = .RowHeight - 1
MsgBox .RowHeight & " -- before"
End With

But sometimes, it's a mistake to do. You could be chopping the top or bottom
line of characters.
 
Hello Rowan

Thank you for your reply Rowan, this comes close but I have now identified
another problem! Is there something that I can do so when the column headers
wrap to the autofit, the wrapping only occurs at breaks between words (not
anywhere within the word as I now have column headers that are difficult to
read where the width of the data in the column is only two or three
characters).
 
Hi Mark

Try this adaption:

Sub header()
Dim eCol As Integer
Dim i As Integer
Dim head As String
Dim hdArr As Variant
Dim j As Integer
Dim hdLen As Integer
Dim tLen As Integer

eCol = Cells(1, Columns.Count).End(xlToLeft).Column
Rows(1).WrapText = False
For i = 1 To eCol
With Cells(1, i)
head = .Value
hdArr = Split(head, " ")
For j = 0 To UBound(hdArr)
tLen = Len(hdArr(j))
If tLen > hdLen Then
hdLen = tLen
End If
Next j
.Value = String(hdLen, "X")
.EntireColumn.AutoFit
.WrapText = True
.Value = head
hdLen = 0
End With
Erase hdArr
Next i
End Sub

Regards
Rowan
 
I should have mentioned that the split function was not available pre
excel 2000 so if you are running an older version of excel then the
solution as it is will result in an error.

Regards
Rowan
 
Back
Top