VBA to resize cells with wrapped text

[steveo411]

Let's try this one now...

My workbook/sheet has some merged cells that have too much data to fit on one line. When I try the double-click trick, it doesn't work!

I need a macro that will start on Row 12, checking Column E and resizing it to fit all the information (Note: Column E is merged E:U; not sure if that makes a difference)

Thanks

[Daxton A.]

This may work: (have not tested)

Sub walkThisWay()
    Dim i As Integer
    Dim j As String     'Original cell string
    Dim k As String     'Chopped cell 1
    Dim l As String     'Chopped cell 2
    
    
    If Len(j) > 32767 Then     'Cell Max is 32,767 characters
        k = Left(j, 32767)
        l = Right(j, Len(j) - 32767)
    End If
    
    
End Sub

Now im not sure but I would think that this will not work for the fact that the data/text has already
been cut down to 32,767 characters in length. You could put a limit on the input form if there is one.

Example: I have built a form for making it easier to read worksheet names on big workbooks and other things...
This form is for inserting a new sheet and it pops up this form for naming the worksheet.

Private Sub cmdOk_Click()
    If txtName.Text = "" Then
        End
    
    ElseIf Len(txtName.Text) < 31 Then
    
        ActiveSheet.Name = txtName.Text
        frmSheetName.Hide
    Else
        MsgBox ("Sheet name can only be 31 characters!")

    End If
End Sub

[steveo411]

Hi..... if I’m reading the post correct, this won’t work for my needs as I am not needing the information chopped down, but rather, need the VBA to resize the entire row so the wrapped text is readable!

Thanks though......

[steveo411]

I was able to make this work, but would like to make the array a little less bulky! Is there a way to make it work using some sort of "E12:E200" verbage?

___________________________________________________________________________ _________

Sub rowSIZE()
'
' rowSIZE Macro
'
' Keyboard Shortcut: Ctrl+Shift+H
Dim mw As Single
Dim cM As Range
Dim rng As Range
Dim cw As Double
Dim rwht As Double
Dim ar As Variant
Dim i As Integer


Application.ScreenUpdating = False
'Cell Ranges below, change to suit.
ar = Array("E12", "E13", "E14", "E15", "E16", "E17", "E18", "E19", "E20", "E21", "E22", "E23", "E24", "E25")


For i = 0 To UBound(ar)
On Error Resume Next
Set rng = Range(Range(ar(i)).MergeArea.Address)
rng.MergeCells = False
cw = rng.Cells(1).ColumnWidth
mw = 0
For Each cM In rng
cM.WrapText = True
mw = cM.ColumnWidth + mw
Next
mw = mw + rng.Cells.Count * 0.66
rng.Cells(1).ColumnWidth = mw
rng.EntireRow.AutoFit
rwht = rng.RowHeight
rng.Cells(1).ColumnWidth = cw
rng.MergeCells = True
rng.RowHeight = rwht
Next i
Application.ScreenUpdating = True
End Sub

[Jan Karel Pieterse]

Dim OneCell as Range
For Each OneCell In Range("E12:E200")
Next

[steveo411]

Thanks, I’ll give it a try and let you know!

[Paul_Hossler]

Can you attach a sample with the Before and the After?

I'm having a really hard time visualizing what you have and what you want to get to