Macro to make text wrap around

[pincivma]

Hi there

I'm not sure how to do this with a macro or if it is even possible. I have a spreadsheet that I have done a wrap text and merge cells in columns C to E from rows 22 to 382. Now every time that the text goes over the allotted length of columns C to E I have to manually make the row bigger so that I could see the wrapped text. Is there a macro than can make the row a perfect fit every time the text goes passed the allotted width of the merged columns C,D and E? I tried the Excel's Autofit Row Height but that does not work.

Thank you.

 

[John_w]

Try this code, which automatically changes the row height to fit the text you enter or change in the cells C22:C382. It is based on https://contexturesblog.com/archives/2012/06/07/autofit-merged-cell-row-height/, but without needing a named range ("OrderNote" in the linked code).

The code must be put in the worksheet module of the sheet. Right-click the sheet tab, then click View Code and paste the code into the module.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim MergeWidth As Single
    Dim cM As Range
    Dim AutoFitRng As Range
    Dim CWidth As Double
    Dim NewRowHt As Double
    
    If Not Intersect(Target, Range("C22:C382")) Is Nothing Then
        Application.ScreenUpdating = False
        Set AutoFitRng = Range(Target.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

 

[pincivma]

Try this code, which automatically changes the row height to fit the text you enter or change in the cells C22:C382. It is based on https://contexturesblog.com/archives/2012/06/07/autofit-merged-cell-row-height/, but without needing a named range ("OrderNote" in the linked code).

The code must be put in the worksheet module of the sheet. Right-click the sheet tab, then click View Code and paste the code into the module.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim MergeWidth As Single
    Dim cM As Range
    Dim AutoFitRng As Range
    Dim CWidth As Double
    Dim NewRowHt As Double
    
    If Not Intersect(Target, Range("C22:C382")) Is Nothing Then
        Application.ScreenUpdating = False
        Set AutoFitRng = Range(Target.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

Hi John
Thank you so much for the code above. I will give it a try and see how it works out. I guess that you were the only one qualified enough to reply back to me.

 

[pincivma]

Hi John
I tested your macro and this is what I found out. The macro does work if I double click inside the cell first and then press enter. If I just press enter the macro does not work

 

[John_w]

Isn't double-clicking inside a cell Excel's standard editing method if you want to edit the cell's contents? Either that or edit it in the formula bar. If you don't double-click then what you type clears the cell's current contents.

The code works for me, and I can either press Enter or press an arrow key to move to another cell to enter the cell's contents.

 

[AllisterB]

Private Sub Worksheet_Change(ByVal Target As Range) Dim MergeWidth As Single Dim cM As Range Dim AutoFitRng As Range Dim CWidth As Double Dim NewRowHt As Double If Not Intersect(Target, Range("C22:C382")) Is Nothing Then Application.ScreenUpdating = False Set AutoFitRng = Range(Target.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

Hi

How would I use this if i only wanted it to apply to cells that had Text (either General or Text Format)?

Allister

 

[John_w]

You could add an extra If statement which checks the cell's format, like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim MergeWidth As Single
    Dim cM As Range
    Dim AutoFitRng As Range
    Dim CWidth As Double
    Dim NewRowHt As Double
   
    If Not Intersect(Target, Range("C22:C382")) Is Nothing Then
       
        Application.ScreenUpdating = False
        Set AutoFitRng = Target.MergeArea
       
        If AutoFitRng.NumberFormat = "@" Or AutoFitRng.NumberFormat = "General" Then 'Text or General format

            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
       
        End If
       
        Application.ScreenUpdating = True
       
    End If
   
End Sub

 

[pincivma]

Try this code, which automatically changes the row height to fit the text you enter or change in the cells C22:C382. It is based on AutoFit Merged Cell Row Height - Contextures Blog, but without needing a named range ("OrderNote" in the linked code).

The code must be put in the worksheet module of the sheet. Right-click the sheet tab, then click View Code and paste the code into the module.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim MergeWidth As Single
    Dim cM As Range
    Dim AutoFitRng As Range
    Dim CWidth As Double
    Dim NewRowHt As Double
   
    If Not Intersect(Target, Range("C22:C382")) Is Nothing Then
        Application.ScreenUpdating = False
        Set AutoFitRng = Range(Target.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

Hi John
Thank you so much for the code. I really appreciated. This saves me a lot of time.
Mario

 

[AllisterB]

Thank you

Could you please clarify. If the Range in the code is say C22:E382 and I add text to merged cells c26:d26, and some cells in col E are formatted as a numbers - will the macro change the height of the row 26 if required?

 

[pincivma]

Thank you

Could you please clarify. If the Range in the code is say C22:E382 and I add text to merged cells c26:d26, and some cells in col E are formatted as a numbers - will the macro change the height of the row 26 if required?

If you are asking if the cells formatted as numbers will merge, the answer is NO. As far as I know, you cannot merge cells that have numbers even if the numbers are formatted as text