Looping with multiple conditions in Userform
 

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

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