Preventing WrapText With Character Limit from changing text to date format

[Jeremy4110]

[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?

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

 

[Jeremy4110]

Re: Need help preventing WrapText With Character Limit from changing text to date format

Hi Peter,

No, I do not want all of the sizes in a single column at the right, nor in their own column at the end of the row.
With so many records and with so many varying sized descriptions (various character lengths greater than 40 characters) it just happens sometimes that the sizes, like 3/8/ and 7/16-14, split at 40 characters moving them to the next (last) column alone. When this happened excel converted what it thought was date (but was actually a size) into a date format. When this happens I need the sizes to remain looking like sizes and not like a date.

Thanks,
Jeremy

 

[Rick Rothstein]

Re: Need help preventing WrapText With Character Limit from changing text to date format

Hi Rick,

...our last code is a lot faster and formats data that looks like a date but is a size to text.

Your wording above is not entirely clear for me... are you saying the code I posted in Message#13 works correctly or not?