Solved: Auto Fit Selected Row Plus 10

[Dave T]

Hello All,

I am after a Worksheet_Change event macro that will adjust the row height if text is wrapped.
I would also like to have some padding or extra spacing applied to data in column J from J4 down.

I have found a macro that does exactly what I am after but it is not a Worksheet_Change event and needs to run manually.

My worksheet has around 700 rows and the following macro can take up to 45 seconds to run. I was hoping it could be changed to a Worksheet_Change event so that every time data in entered into column J from row 4 down it would adjust the height of that specific row rather than run on the entire worksheet.

Sub AutoFitSelectedSheets()
'http://answers.microsoft.com/en-us/office/forum/office_2007-excel/auto-fit-row-height-is-not-sufficient/4f3dddfe-9762-e011-8dfc-68b599b31bf5
' adjusts row height if text is wrapped
  Dim wsh As Worksheet
  Dim rng As Range
  Application.ScreenUpdating = False
  For Each wsh In ActiveWindow.SelectedSheets
    With wsh.UsedRange
      .EntireRow.AutoFit
      For Each rng In .Rows
        rng.RowHeight = rng.RowHeight + 10
      Next rng
      .VerticalAlignment = xlCenter
    End With
  Next wsh
  Application.ScreenUpdating = True
End Sub

Regards,
Dave T

[SamT]

Place this in the appropriate Worksheet code page.
[vba]
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row < 4 then Exit Sub

'N = number of last column data is entered in.
Const N As Long = 1 'Change to suit
If Target.Column <> N Then Exit Sub

Application.ScreenUpdating = False
With Target.EntireRow
.AutoFit
.RowHeight = .RowHeight + 10
.VerticalAlignment = xlCenter
End With
Application.ScreenUpdating = True
End Sub
[/vba]

[Dave T]

Hello SamT,

Works perfectly.
I appreciate your help.

Regards,
Dave T