PDA

View Full Version : [SOLVED] VBA to resize cells with wrapped text



steveo411
10-26-2018, 04:15 PM
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.
10-27-2018, 09:06 PM
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
10-27-2018, 10:35 PM
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
10-29-2018, 07:36 AM
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
10-29-2018, 08:56 AM
Dim OneCell as Range
For Each OneCell In Range("E12:E200")
Next

steveo411
10-29-2018, 09:06 AM
Thanks, I’ll give it a try and let you know!

Paul_Hossler
10-29-2018, 09:56 AM
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