Preventing WrapText With Character Limit from changing text to date format

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?


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:

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Re: Need help preventing WrapText With Character Limit from changing text to date format

Try this ..

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[COLOR=#ff0000] & " "[/COLOR]
                    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
 [COLOR=#ff0000]   Columns("D").Replace What:=" ", Replacement:="'"[/COLOR]

    Exit Sub
NoCellsSelected:
End Sub
 
Upvote 0
Re: Need help preventing WrapText With Character Limit from changing text to date format

Hi Yongle,

Thanks for your reply. You alterations worked, sort of, but it left a "'" between the words in the 2nd, 3rd, etc. descriptions. My revision to your code left a blank space, which still isn't exactly what i needed so I formatted the cells to "TEXT" and added a trim code to it and that seems to be working. I tried putting all of this into one macro but I could not get it to work that way so I created a new TEST macro to control the other two. Would you mind taking a look at it to see if you can find a way to combine both macros into one script?


Code:
Sub TEST()


    Description_WrapText_With_Character_Limit


    Range("C:G").NumberFormat = "@"


    TrimIt


End Sub




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
[COLOR=#ff0000]    Range("C:G").Replace What:=" ", Replacement:=" "[/COLOR]
    Exit Sub
NoCellsSelected:


End Sub




Sub TrimIt()


    Range("BC:BC,BL:BL,BU:BU,CD:CD,CM:CM,CV:CV,DE:DE,DN:DN,DW:DW,EF:EF,EO:EO,EX:EX").NumberFormat = "@"


    Dim Addr As String
    Addr = Range("A1").CurrentRegion.Resize(Cells(Rows.Count, "A").End(xlUp).Row).Address
    Intersect(ActiveSheet.UsedRange, Range("E:F,M:O")).NumberFormat = "@"
    Range(Addr) = Evaluate("IF(" & Addr & "="""","""",TRIM(SUBSTITUTE(" & Addr & ",""_"","" "")))")


End Sub


Thanks,
Jeremy
 
Upvote 0
Re: Need help preventing WrapText With Character Limit from changing text to date format

The amendment was tested using the sample data provided in post#1
Please post 5 typical longer "Original Descriptions" together with expected results

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

[TABLE="width: 690"]
<tbody>[TR]
[TD="width: 65"]
Part #
[/TD]
[TD="width: 327"]
Original Description
[/TD]
[TD="width: 300"]
Desc 1
[/TD]
[TD="width: 101"]
Results
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111"]
Expected Results
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN1440
[/TD]
[TD="width: 327, bgcolor: transparent"] 1440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/8
[/TD]
[TD="width: 300, bgcolor: transparent"] 1440 A997080 FLAT SOCK HD CAP SCR 6-40 X
[/TD]
[TD="width: 101, bgcolor: transparent"] 8-Mar or 43532
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 3/8
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
TWN1442
[/TD]
[TD="width: 327, bgcolor: transparent"] 1442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/8
[/TD]
[TD="width: 300, bgcolor: transparent"] 1442 A997082 FLAT SOCK HD CAP SCR 6-40 X
[/TD]
[TD="width: 101, bgcolor: transparent"] 8-Mar or 43593
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 5/8
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN1023
[/TD]
[TD="width: 327, bgcolor: transparent"] 1023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-14
[/TD]
[TD="width: 300, bgcolor: transparent"] 1023 -33645-1 SOCK HD 3/4 CAP SCR
[/TD]
[TD="width: 101, bgcolor: transparent"]
7/16/2014
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 7/16-14
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN1231
[/TD]
[TD="width: 327, bgcolor: transparent"] 1231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-18
[/TD]
[TD="width: 300, bgcolor: transparent"] 1231 MP33620-1 SOCK HD 1-1/4 CAP SCR
[/TD]
[TD="width: 101, bgcolor: transparent"]
5/16/2018
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 5/16-18
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN1286
[/TD]
[TD="width: 327, bgcolor: transparent"] 1286 -40227-1 SOCK HD 1/2 CAP SCR 5/16-24
[/TD]
[TD="width: 300, bgcolor: transparent"] 1286 -40227-1 SOCK HD 1/2 CAP SCR
[/TD]
[TD="width: 101, bgcolor: transparent"]
5/16/2024
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 5/16-24
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN1291
[/TD]
[TD="width: 327, bgcolor: transparent"] 1291 -40230-1 SOCK HD CAP SCR 5/16-24X1-1/4
[/TD]
[TD="width: 300, bgcolor: transparent"] 1291 -40230-1 SOCK HD CAP SCR
[/TD]
[TD="width: 101, bgcolor: transparent"] 5/16-24X1-1/4
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 5/16-24X1-1/4
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN2040
[/TD]
[TD="width: 327, bgcolor: transparent"] 2040 -40214-P SHCS WITH NY PELLET, 10-32X1
[/TD]
[TD="width: 300, bgcolor: transparent"] 2040 -40214-P SHCS WITH NY PELLET,
[/TD]
[TD="width: 101, bgcolor: transparent"] 10-32X1
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 10-32X1
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN2049
[/TD]
[TD="width: 327, bgcolor: transparent"] 2049 48356 FLAT SOCK HD CAP SCR 6-32X1-1/2
[/TD]
[TD="width: 300, bgcolor: transparent"] 2049 48356 FLAT SOCK HD CAP SCR
[/TD]
[TD="width: 101, bgcolor: transparent"] 6-32X1-1/2
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] 6-32X1-1/2
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN2379
[/TD]
[TD="width: 327, bgcolor: transparent"] 2379 36677 B7 THREADED ROD 3/8-16X36 - ZY
[/TD]
[TD="width: 300, bgcolor: transparent"] 2379 36677 B7 THREADED ROD 3/8-16X36 -
[/TD]
[TD="width: 101, bgcolor: transparent"] ZY
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] ZY
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN5214
[/TD]
[TD="width: 327, bgcolor: transparent"] 5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 - PL
[/TD]
[TD="width: 300, bgcolor: transparent"] 5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11
[/TD]
[TD="width: 101, bgcolor: transparent"] - PL
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] - PL
[/TD]
[/TR]
[TR]
[TD="width: 65, bgcolor: transparent"]
CHN5262
[/TD]
[TD="width: 327, bgcolor: transparent"] 5262 99769 HARDENED FLAT WASHER-PLAIN 1 USS
[/TD]
[TD="width: 300, bgcolor: transparent"] 5262 99769 HARDENED FLAT WASHER-PLAIN 1
[/TD]
[TD="width: 101, bgcolor: transparent"] USS
[/TD]
[TD="width: 16"]
[/TD]
[TD="width: 111, bgcolor: transparent"] USS
[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Re: Need help preventing WrapText With Character Limit from changing text to date format

Is anything else required ?
VBA below simply splits the text at the final space

BEFORE
Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1
[/td][td]Part #[/td][td]Original Description[/td][td] [/td][td] [/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2
[/td][td]CHN1440[/td][td]1440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/8[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3
[/td][td]TWN1442[/td][td]1442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/8[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4
[/td][td]CHN1023[/td][td]1023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-14[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5
[/td][td]CHN1231[/td][td]1231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-18[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6
[/td][td]CHN1286[/td][td]1286 -40227-1 SOCK HD 1/2 CAP SCR 5/16-24[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7
[/td][td]CHN1291[/td][td]1291 -40230-1 SOCK HD CAP SCR 5/16-24X1-1/4[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8
[/td][td]CHN2040[/td][td]2040 -40214-P SHCS WITH NY PELLET, 10-32X1[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
9
[/td][td]CHN2049[/td][td]2049 48356 FLAT SOCK HD CAP SCR 6-32X1-1/2[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
10
[/td][td]CHN2379[/td][td]2379 36677 B7 THREADED ROD 3/8-16X36 - ZY[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
11
[/td][td]CHN5214[/td][td]5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 - PL[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
12
[/td][td]CHN5262[/td][td]5262 99769 HARDENED FLAT WASHER-PLAIN 1 USS[/td][td][/td][td][/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: SplitDesc[/td][/tr][/table]

AFTER

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1
[/td][td]Part #[/td][td]Original Description[/td][td] [/td][td] [/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2
[/td][td]CHN1440[/td][td]1440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/8[/td][td]1440 A997080 FLAT SOCK HD CAP SCR 6-40 X[/td][td]3/8[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3
[/td][td]TWN1442[/td][td]1442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/8[/td][td]1442 A997082 FLAT SOCK HD CAP SCR 6-40 X[/td][td]5/8[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4
[/td][td]CHN1023[/td][td]1023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-14[/td][td]1023 -33645-1 SOCK HD 3/4 CAP SCR[/td][td]7/16-14[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5
[/td][td]CHN1231[/td][td]1231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-18[/td][td]1231 MP33620-1 SOCK HD 1-1/4 CAP SCR[/td][td]5/16-18[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6
[/td][td]CHN1286[/td][td]1286 -40227-1 SOCK HD 1/2 CAP SCR 5/16-24[/td][td]1286 -40227-1 SOCK HD 1/2 CAP SCR[/td][td]5/16-24[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7
[/td][td]CHN1291[/td][td]1291 -40230-1 SOCK HD CAP SCR 5/16-24X1-1/4[/td][td]1291 -40230-1 SOCK HD CAP SCR[/td][td]5/16-24X1-1/4[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8
[/td][td]CHN2040[/td][td]2040 -40214-P SHCS WITH NY PELLET, 10-32X1[/td][td]2040 -40214-P SHCS WITH NY PELLET,[/td][td]10-32X1[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
9
[/td][td]CHN2049[/td][td]2049 48356 FLAT SOCK HD CAP SCR 6-32X1-1/2[/td][td]2049 48356 FLAT SOCK HD CAP SCR[/td][td]6-32X1-1/2[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
10
[/td][td]CHN2379[/td][td]2379 36677 B7 THREADED ROD 3/8-16X36 - ZY[/td][td]2379 36677 B7 THREADED ROD 3/8-16X36 -[/td][td]ZY[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
11
[/td][td]CHN5214[/td][td]5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 - PL[/td][td]5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 -[/td][td]PL[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
12
[/td][td]CHN5262[/td][td]5262 99769 HARDENED FLAT WASHER-PLAIN 1 USS[/td][td]5262 99769 HARDENED FLAT WASHER-PLAIN 1[/td][td]USS[/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: SplitDesc[/td][/tr][/table]

Code:
Sub SplitDesc()
    Dim Cel As Range, Desc As String, Desc1 As String
    On Error Resume Next
    For Each Cel In Range("B2", Range("B" & Rows.Count).End(xlUp))
            Desc = Cel.Value
            Desc1 = Left(Desc, InStrRev(Desc, " ") - 1)
            Cel.Offset(, 1) = Desc1
            Cel.Offset(, 2).NumberFormat = "@"
            Cel.Offset(, 2) = Trim(Replace(Desc, Desc1, ""))
    Next Cel
End Sub
 
Upvote 0
Re: Need help preventing WrapText With Character Limit from changing text to date format

Thread title includes "preventing WrapText With Character Limit" but I've seen nothing in any written description or examples that seem to relate to that. Everything just seems to be about one part of the result changing to date format.
Makes me wonder if sufficient information has been given? :confused:
 
Upvote 0
Re: Need help preventing WrapText With Character Limit from changing text to date format

Hi Yongle,

Thank you so much for your help, I greatly appreciate it. I think Peter_SSs may be correct in that I have not provided enough information for you to be able understand my need. I work for a distribution company and receive large excel files with 80-100K records. It is my job to concatenate the manufacturer’s part number, description and size fields. The concatenation of these three fields can sometimes be 20-300 characters, the problem is that our archaic system has a 40-character limit per field, which is why I am using the particular macro from my original post. The parameters that I have to work with are;
1.) I can NOT exceed 40 characters per filed.
2.) I can NOT separate a searchable words like “aerosol” into two fields, like ending with “ae” in field and starting with “rosol” in the next field because search feature won’t find a match for “aerosol”.
3.) I need sizes like 3/8 and 7/16-14 to remain looking like sizes when separated alone in the next field and not convert them to a date like 8-Mar or 7/16/14 or converting from a date to text like 43532 or 41836.

I hope this helps to better explain what I need to be able to do. If you have any questions please do not hesitate to ask as I will do whatever I can to help you, help me.

Thanks,
Jeremy

[tb]
[TABLE="width: 1558"]
<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Description[/TD]
[TD]Description[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]End w/ This[/TD]
[TD]Not This[/TD]
[TD]Not This[/TD]
[/TR]
[TR]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 7/16-14[/TD]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY[/TD]
[TD]NAME IS TESTIT 52303 THREADED ROD ROD[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD][/TD]
[TD]7/16-14[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD]41836[/TD]
[/TR]
[TR]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 3/8[/TD]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY[/TD]
[TD]NAME IS TESTIT 52303 THREADED ROD ROD[/TD]
[TD="align: right"]8-Mar[/TD]
[TD][/TD]
[TD]3/8[/TD]
[TD="align: right"]8-Mar[/TD]
[TD]43532[/TD]
[/TR]
[TR]
[TD]1440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/8[/TD]
[TD]1440 A997080 FLAT SOCK HD CAP SCR 6-40 X[/TD]
[TD="align: right"]8-Mar[/TD]
[TD][/TD]
[TD][/TD]
[TD]3/8[/TD]
[TD="align: right"]8-Mar[/TD]
[TD]43532[/TD]
[/TR]
[TR]
[TD]1442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/8[/TD]
[TD]1442 A997082 FLAT SOCK HD CAP SCR 6-40 X[/TD]
[TD="align: right"]8-May[/TD]
[TD][/TD]
[TD][/TD]
[TD]5/8[/TD]
[TD="align: right"]8-May[/TD]
[TD]43593[/TD]
[/TR]
[TR]
[TD]1023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-14[/TD]
[TD]1023 -33645-1 SOCK HD 3/4 CAP SCR[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD][/TD]
[TD][/TD]
[TD]7/16-14[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD]41836[/TD]
[/TR]
[TR]
[TD]1231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-18[/TD]
[TD]1231 MP33620-1 SOCK HD 1-1/4 CAP SCR[/TD]
[TD="align: right"]5/16/2018[/TD]
[TD][/TD]
[TD][/TD]
[TD]5/16-18[/TD]
[TD="align: right"]5/16/2018[/TD]
[TD]43236[/TD]
[/TR]
</tbody>[/TABLE]
[/tb]
 
Upvote 0
Re: Need help preventing WrapText With Character Limit from changing text to date format

Cell A1 should be Item# not Part# as they are two different references. Item# is our internal number and the part number comes from the manufacturer.

[TABLE="width: 1644"]
<colgroup><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Item #[/TD]
[TD]Description[/TD]
[TD]Description[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]End w/ This[/TD]
[TD] Not This[/TD]
[TD] Not This[/TD]
[/TR]
[TR]
[TD]TR91156[/TD]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 7/16-14[/TD]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY[/TD]
[TD]NAME IS TESTIT 52303 THREADED ROD ROD[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD][/TD]
[TD]7/16-14[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD] 41836[/TD]
[/TR]
[TR]
[TD]TR91156[/TD]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 3/8[/TD]
[TD]MY NAME IS TESTIT 52303 THREADED ROD MY[/TD]
[TD]NAME IS TESTIT 52303 THREADED ROD ROD[/TD]
[TD="align: right"]8-Mar[/TD]
[TD][/TD]
[TD]3/8[/TD]
[TD="align: right"]8-Mar[/TD]
[TD] 43532[/TD]
[/TR]
[TR]
[TD]CHN1440[/TD]
[TD]1440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/8[/TD]
[TD]1440 A997080 FLAT SOCK HD CAP SCR 6-40 X[/TD]
[TD="align: right"]8-Mar[/TD]
[TD][/TD]
[TD][/TD]
[TD]3/8[/TD]
[TD="align: right"]8-Mar[/TD]
[TD] 43532[/TD]
[/TR]
[TR]
[TD]TWN1442[/TD]
[TD]1442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/8[/TD]
[TD]1442 A997082 FLAT SOCK HD CAP SCR 6-40 X[/TD]
[TD="align: right"]8-May[/TD]
[TD][/TD]
[TD][/TD]
[TD]5/8[/TD]
[TD="align: right"]8-May[/TD]
[TD] 43593[/TD]
[/TR]
[TR]
[TD]CHN1023[/TD]
[TD]1023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-14[/TD]
[TD]1023 -33645-1 SOCK HD 3/4 CAP SCR[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD][/TD]
[TD][/TD]
[TD]7/16-14[/TD]
[TD="align: right"]7/16/2014[/TD]
[TD] 41836[/TD]
[/TR]
[TR]
[TD]CHN1231[/TD]
[TD]1231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-18[/TD]
[TD]1231 MP33620-1 SOCK HD 1-1/4 CAP SCR[/TD]
[TD="align: right"]5/16/2018[/TD]
[TD][/TD]
[TD][/TD]
[TD]5/16-18[/TD]
[TD="align: right"]5/16/2018[/TD]
[TD] 43236[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Re: Need help preventing WrapText With Character Limit from changing text to date format

Try this variation

Code:
Sub Description_WrapText_With_Character_Limit()
    Application.ScreenUpdating = False
    Dim X As String: X = Chr(160)
    Dim Cel As Range
    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 = X & Mid(Text, MaxChars + 2)
            Else
                Space = InStrRev(TextMax, " ")
                If Space = 0 Then
                    SplitText = SplitText & Left(Text, MaxChars) & vbLf
                    Text = X & Mid(Text, MaxChars + 1)
                Else
                    SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
                    Text = X & 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

    For Each Cel In Source.Resize(, 10)
        On Error Resume Next
        If Left(Cel.Text, 1) = Chr(160) Then Cel.Value = Mid(Cel.Text, 2, 39)
    Next
    Exit Sub
NoCellsSelected:
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top