Range of cells autofit

[MartinST]

I have on sheet 2 the following scenario;
Columns C:AF are merged from rows 17:49. These referred rows gets data from sheet 1 through single columns in rows 17:49. I have difficulty to auto fit the data on sheet 2 if the data overflows the merged columns width. I have tried the following code with no success, the data doesn’t auto fit in the merged cells.

Private Sub Worksheet_Activate()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Rows("17:49").EntireRow.AutoFit
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Application.ScreenUpdating = True
End Sub

Pls give me some direction.

 

[ukmikeb]

Hi

maybe this article will set you on your way -

http://answers.microsoft.com/en-us/...ed-cells/05cc8ced-9c78-40d5-82eb-d882e488b8fd

hth

 

[MartinST]

Thanks a lot, it certainly put me on the right track and I found this code on another page that works perfectly.

Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RangeWidth As Single
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
RangeWidth = .Width
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
While .Cells(1).Width < RangeWidth
.Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
Wend
.Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub

 

[ukmikeb]

Hi

Pleased to have helped you solve your problem.

Good luck with your project.