I need a macro that will adjust the row height of merged cells.

[dstetar]

I am looking to find a macro or update the one that I have so that I can with a short cut key have it automatically set the row height so that all the wrapped text will be shown. I was given a macro by someone else that automatically set the row height each time the text wraps in a cell. Up until now it has worked great, but the size of my spread sheet and the number of tabs has grow to large and this macro is now takes 20 seconds every time you hit enter. So what I am trying to write or hoping someone else can help me with is a macro that will adjust the row height for any merged cells that I select and that I can assign to a shortcut key. I am working in windows 7 with excel 2007.

Thanks for any help or suggestions.

 

[dermie_72]

Can you post the code of the macro you are using so it can be reviewed.

 

[dstetar]

Sure here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub

 

[dermie_72]

Does that macro work for you?
I'm assuming that the row high is being taken from another row due to the set c reference.

You could simplify it by:

With Selection.Font
.Name = "Calibri"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With

Then go to view/macro/macros options, and assign a short cut key that way.

If your macro works the way you want, and justw ant a shortcut key, then do the above which will work.

 

[dstetar]

Thanks, your code gave me some good Ideas for some other problems I have been having but it does not solve my main problem. I need a maco that will automatical adjust the row height for wrapped text in a merged cell. Excel will automatical adjust the row heith if a non megerd cell in that row has wrapped text but it will not recognised the wraped text in a merged cell. I dont want to change any of the formating or anything else in the cells just the row height. The code that I posted does work but my workbook has grown so large that it takes 20 seconds everytime you hit enter to calculate the new row height. I thank you so much for you help and the great Ideas that you have given me.