Looping with multiple conditions in Userform
columnm width is not the number of character in the column but the number of
pixels in the column. Depending on your font each character has a different
font.
To add new lines into a cell use vbCRLF which is equivalent to Alt- Enter.
"Marcolino" wrote:
I'm developing a userform for a resolutions tracking table. The userform
inputs data into a series of named ranges comprising a two-row area,
inserting new rows and merging cells as necessary to contain all of the data.
When the user clicks OK, I want the data in the target cell in Column B
("adoptedbywhom") to wrap into the cells below, but only after checking
whether there are enough rows in the two-row area to contain the text; if
more rows are needed, it should insert an new row within the two-row area so
that when the target cell is merged with the two cells below it, the data
remains inside the original two-row area (now expanded by one row).
For some reason, I can't get the userform to enter that new row:
Sub Testing()
Dim SelRange As Range
Dim ResRange As Range
Dim RowNum As Integer
Set SelRange = Range("adoptedbywhom")
Set ResRange = Range("resolutionsynopsis", "resolutiondescription")
If (Len(SelRange.Text) / SelRange.ColumnWidth) 1 Then
If (Len(ResRange.Text) / ResRange.ColumnWidth) <= (Len(SelRange.Text) /
SelRange.ColumnWidth) Then
For RowNum = 1 To CInt((Len(SelRange.Text) / SelRange.ColumnWidth) +
2)
Range("resolutiondescription").Rows.Insert
Application.Goto "adoptedbywhom"
With selection
.Resize(selection.Rows.Count + 1, _
selection.Columns.Count).Merge
.WrapText = True
End With
Next RowNum
Else
For RowNum = 1 To CInt((Len(SelRange.Text) / SelRange.ColumnWidth) +
2)
With selection
.Resize(selection.Rows.Count + 1, _
selection.Columns.Count).Merge
.WrapText = True
End With
Next RowNum
End If
End If
End Sub
|