Extending VBA code to expand rows for more than one cell

[Godot60]

Hi,

I have a VBA code statement that expands a cell and row as more text is entered. It works great even on a merged cell. How do I extend this so that it works with other cells on my sheet? Do I have to write this code over and over again for each cell, or can I include it all in one code statement? Any help would be appreciated. Thanks.

Code:

Dim MergeWidth As Single
Dim cM As Range
Dim AutoFitRng As Range
Dim CWidth As Double
Dim NewRowHt As Double
Dim str01 As String
str01 = "area1"

If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)

With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If



End Sub

 

[Tom Urtis]

It seems the restriction is invoked here:

Dim str01 As String
str01 = "area1"

If Not Intersect(Target, Range(str01)) Is Nothing Then

I assume "area1" is a table or a named range. In any case, if you want to allow for this behavior to apply to, say, column C, you can supplant the above 3 lines with

If Target.column <> 3 then exit sub
And of course delete the terminating End If and put this code line at the beginning of the procedure because the variables don't need to be declared if the activity is happening in a column other than C.

There are other options too, depending on what you're actually doing.

 

[Godot60]

Thanks Tom. This worked great! Much appreciated!