Worksheet_Activate not working on multiple cells

[rounder911]

So I have a macro that runs when Sheet1 is opened that resizes cells in

my selected ranges. Unfortunately, it only seems to resize the first
cell in the range and not the others ... any ideas?


Private Sub Worksheet_Activate()
Dim myCell As Range
For Each myCell In Me.Range("b1:b3", "b5:b8").Cells
myCell.Select
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
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
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight,
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next myCell
End Sub

 

[rounder911]

I have a macro that runs when Sheet1 is opened that resizes cells in my
selected ranges. Unfortunately, it only seems to resize the first cell
in the range and not the others ... also gives me a Run-time error
'1004' - Unable to set the ColumnWidth property of the Range class. If
I only attempt to use on 1 or 2 cells it doesn't give me this error.
Any ideas?


Private Sub Worksheet_Activate()
Dim myCell As Range
For Each myCell In Me.Range("b1:b3", "b5:b8").Cells
myCell.Select
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
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
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight,
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Next myCell
End Sub