Jeremy4110
Board Regular
- Joined
- Sep 26, 2015
- Messages
- 70
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Part #
[/TD]
[TD]Original Description
[/TD]
[TD]Description1
[/TD]
[TD]Description 2
[/TD]
[TD]Description 2 Correction
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]I NEED TO TEST IT 52303 THREADED ROD 7/16-14
[/TD]
[TD]I NEED TO TEST IT 52303 THREADED ROD
[/TD]
[TD]7/16/2014
[/TD]
[TD]7/16-14
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]I NEED TO TEST IT 52300 THREADED ROD 1/4-20
[/TD]
[TD]I NEED TO TEST IT 52303 THREADED ROD
[/TD]
[TD]1/4/2020
[/TD]
[TD]1/4-20
[/TD]
[/TR]
</tbody>[/TABLE]
Hi,
I came across the code below which works, sort of. The issue I am having is that it changes my "TEXT" to a "DATE" when it separates the data into the second column. Does anyone have a fix that ensures that all cells remain in "TEXT" format?
Thanks,
Jeremy
<tbody>[TR]
[TD]Part #
[/TD]
[TD]Original Description
[/TD]
[TD]Description1
[/TD]
[TD]Description 2
[/TD]
[TD]Description 2 Correction
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]I NEED TO TEST IT 52303 THREADED ROD 7/16-14
[/TD]
[TD]I NEED TO TEST IT 52303 THREADED ROD
[/TD]
[TD]7/16/2014
[/TD]
[TD]7/16-14
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]I NEED TO TEST IT 52300 THREADED ROD 1/4-20
[/TD]
[TD]I NEED TO TEST IT 52303 THREADED ROD
[/TD]
[TD]1/4/2020
[/TD]
[TD]1/4-20
[/TD]
[/TR]
</tbody>[/TABLE]
Hi,
I came across the code below which works, sort of. The issue I am having is that it changes my "TEXT" to a "DATE" when it separates the data into the second column. Does anyone have a fix that ensures that all cells remain in "TEXT" format?
Code:
Sub Description_WrapText_With_Character_Limit()
Dim Text As String, TextMax As String, SplitText As String
Dim Space As Long, MaxChars As Long
Dim Source As Range, CellWithText As Range
' With offset as 1, split data will be adjacent to original data
' With offset = 0, split data will replace original data
Const DestinationOffset As Long = 1
MaxChars = 40 'Application.InputBox("Maximum number of characters per line?", Type:=1)
Set Source = Range("B1", Cells(Rows.Count, "B").End(xlUp))
For Each CellWithText In Source
Text = CellWithText.Value
SplitText = ""
Do While Len(Text) > MaxChars
TextMax = Left(Text, MaxChars + 1)
If Right(TextMax, 1) = " " Then
SplitText = SplitText & RTrim(TextMax) & vbLf
Text = Mid(Text, MaxChars + 2)
Else
Space = InStrRev(TextMax, " ")
If Space = 0 Then
SplitText = SplitText & Left(Text, MaxChars) & vbLf
Text = Mid(Text, MaxChars + 1)
Else
SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
Text = Mid(Text, Space + 1)
End If
End If
Loop
CellWithText.Offset(, DestinationOffset).Value = SplitText & Text
Next
Columns("C").TextToColumns Range("C1"), xlDelimited, , , False, False, False, False, True, vbLf
Exit Sub
NoCellsSelected:
End Sub
Thanks,
Jeremy
Last edited: