Worksheet_Activate not working for multiple cells

R

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Auto fit wrapped and merged cells in entire worksheet 8
Merged Cells Autofit Macro Code 1
Autofit with Merged Cells/Wrap Text Macro Problem 3
Using this Automatic Resizing Macro with Worksheet Change 0
Worksheet_Activate not working on multiple cells 1
AutoFit Macro to Reduce row height? 0
Auto fit wrapped and merged cells in entire worksheet Options 0
Row height 3

Top