I got a workaround myself:
'G = Maximum amount of characters for width of comment cell
G = 100
'CommentX
If THISWB.Sheets("Source").Cells(i, CommentColumn).Value = "" Then
CommentX = ""
Else
CommentArray = Split(THISWB.Sheets("Source").Cells(i, CommentColumn).Value, Chr(10)) 'splits on alt + enter
DeliverableComment = "Available"
End If
If CommentX <> "" Then
'this loops for each newline in a cell (alt+enter in cell)
For CommentPart = 0 To UBound(CommentArray)
'format comment to max G characters long
LASTSPACE = 0
LASTSPACE2 = 0
If Len(CommentArray(CommentPart)) > G Then
'find last space in G length character string to make sure the line ends with a whole word and the new line starts with a whole word
Do Until LASTSPACE2 >= Len(CommentArray(CommentPart))
If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
ActiveCell.AddComment Left(CommentArray(CommentPart), LASTSPACE)
Else
If LASTSPACE2 = 0 Then
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Left(CommentArray(CommentPart), LASTSPACE)
Else
If Len(Mid(CommentArray(CommentPart), LASTSPACE2)) < G Then
LASTSPACE = Len(Mid(CommentArray(CommentPart), LASTSPACE2))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
Else
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "þ", (Len(Mid(CommentArray(CommentPart), LASTSPACE2, G)) - Len(WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "")))))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
End If
End If
End If
LASTSPACE2 = LASTSPACE + LASTSPACE2 + 1
Loop
Else
If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
ActiveCell.AddComment CommentArray(CommentPart)
Else
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & CommentArray(CommentPart)
End If
End If
Next CommentPart
ActiveCell.Comment.Shape.TextFrame.AutoSize = True
End If
Feel free to thank me. Works like a charm to me and the autosize function also works!
Round
behaves that way. The problem is what it does forvalue = 0.5
. – Poulos