View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.misc
 
Posts: n/a
Default Worksheet_Activate not working for multiple cells

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