Preventing WrapText With Character Limit from changing text to date format

J

Jeremy4110

Board Regular
Joined
Sep 26, 2015
Messages
70
Part #
Original Description
Description1
Description 2
Description 2 Correction
1
I NEED TO TEST IT 52303 THREADED ROD 7/16-14
I NEED TO TEST IT 52303 THREADED ROD
7/16/2014
7/16-14
2
I NEED TO TEST IT 52300 THREADED ROD 1/4-20
I NEED TO TEST IT 52303 THREADED ROD
1/4/2020
1/4-20

<tbody>
</tbody>











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

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
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

Part #​
Original Description​
Desc 1​
Results​
Expected Results​
CHN1440​
 1440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/8
 1440 A997080 FLAT SOCK HD CAP SCR 6-40 X
 8-Mar or 43532
3/8
TWN1442​
 1442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/8
 1442 A997082 FLAT SOCK HD CAP SCR 6-40 X
 8-Mar or 43593
5/8
CHN1023​
 1023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-14
 1023 -33645-1 SOCK HD 3/4 CAP SCR
7/16/2014​
7/16-14
CHN1231​
 1231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-18
 1231 MP33620-1 SOCK HD 1-1/4 CAP SCR
5/16/2018​
5/16-18
CHN1286​
 1286 -40227-1 SOCK HD 1/2 CAP SCR 5/16-24
 1286 -40227-1 SOCK HD 1/2 CAP SCR
5/16/2024​
5/16-24
CHN1291​
 1291 -40230-1 SOCK HD CAP SCR 5/16-24X1-1/4
 1291 -40230-1 SOCK HD CAP SCR
 5/16-24X1-1/4
5/16-24X1-1/4
CHN2040​
 2040 -40214-P SHCS WITH NY PELLET, 10-32X1
 2040 -40214-P SHCS WITH NY PELLET,
 10-32X1
10-32X1
CHN2049​
 2049 48356 FLAT SOCK HD CAP SCR 6-32X1-1/2
 2049 48356 FLAT SOCK HD CAP SCR
 6-32X1-1/2
6-32X1-1/2
CHN2379​
 2379 36677 B7 THREADED ROD 3/8-16X36 - ZY
 2379 36677 B7 THREADED ROD 3/8-16X36 -
 ZY
ZY
CHN5214​
 5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 - PL
 5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11
 - PL
- PL
CHN5262​
 5262 99769 HARDENED FLAT WASHER-PLAIN 1 USS
 5262 99769 HARDENED FLAT WASHER-PLAIN 1
 USS
USS
<tbody> </tbody>
 
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
A​
B​
C​
D​
1​
Part #Original Description
2​
CHN14401440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/8
3​
TWN14421442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/8
4​
CHN10231023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-14
5​
CHN12311231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-18
6​
CHN12861286 -40227-1 SOCK HD 1/2 CAP SCR 5/16-24
7​
CHN12911291 -40230-1 SOCK HD CAP SCR 5/16-24X1-1/4
8​
CHN20402040 -40214-P SHCS WITH NY PELLET, 10-32X1
9​
CHN20492049 48356 FLAT SOCK HD CAP SCR 6-32X1-1/2
10​
CHN23792379 36677 B7 THREADED ROD 3/8-16X36 - ZY
11​
CHN52145214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 - PL
12​
CHN52625262 99769 HARDENED FLAT WASHER-PLAIN 1 USS
Sheet: SplitDesc

AFTER

Excel 2016 (Windows) 32 bit
A​
B​
C​
D​
1​
Part #Original Description
2​
CHN14401440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/81440 A997080 FLAT SOCK HD CAP SCR 6-40 X3/8
3​
TWN14421442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/81442 A997082 FLAT SOCK HD CAP SCR 6-40 X5/8
4​
CHN10231023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-141023 -33645-1 SOCK HD 3/4 CAP SCR7/16-14
5​
CHN12311231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-181231 MP33620-1 SOCK HD 1-1/4 CAP SCR5/16-18
6​
CHN12861286 -40227-1 SOCK HD 1/2 CAP SCR 5/16-241286 -40227-1 SOCK HD 1/2 CAP SCR5/16-24
7​
CHN12911291 -40230-1 SOCK HD CAP SCR 5/16-24X1-1/41291 -40230-1 SOCK HD CAP SCR5/16-24X1-1/4
8​
CHN20402040 -40214-P SHCS WITH NY PELLET, 10-32X12040 -40214-P SHCS WITH NY PELLET,10-32X1
9​
CHN20492049 48356 FLAT SOCK HD CAP SCR 6-32X1-1/22049 48356 FLAT SOCK HD CAP SCR6-32X1-1/2
10​
CHN23792379 36677 B7 THREADED ROD 3/8-16X36 - ZY2379 36677 B7 THREADED ROD 3/8-16X36 -ZY
11​
CHN52145214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 - PL5214 99786 GRADE 8 HEX NUT-PLAIN 5/8-11 -PL
12​
CHN52625262 99769 HARDENED FLAT WASHER-PLAIN 1 USS5262 99769 HARDENED FLAT WASHER-PLAIN 1USS
Sheet: SplitDesc

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]
DescriptionDescriptionEnd w/ ThisNot ThisNot This
MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 7/16-14MY NAME IS TESTIT 52303 THREADED ROD MYNAME IS TESTIT 52303 THREADED ROD ROD7/16/20147/16-147/16/201441836
MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 3/8MY NAME IS TESTIT 52303 THREADED ROD MYNAME IS TESTIT 52303 THREADED ROD ROD8-Mar3/88-Mar43532
1440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/81440 A997080 FLAT SOCK HD CAP SCR 6-40 X8-Mar3/88-Mar43532
1442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/81442 A997082 FLAT SOCK HD CAP SCR 6-40 X8-May5/88-May43593
1023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-141023 -33645-1 SOCK HD 3/4 CAP SCR7/16/20147/16-147/16/201441836
1231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-181231 MP33620-1 SOCK HD 1-1/4 CAP SCR5/16/20185/16-185/16/201843236

<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>
[/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.

Item #DescriptionDescriptionEnd w/ This Not This Not This
TR91156MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 7/16-14MY NAME IS TESTIT 52303 THREADED ROD MYNAME IS TESTIT 52303 THREADED ROD ROD7/16/20147/16-147/16/2014 41836
TR91156MY NAME IS TESTIT 52303 THREADED ROD MY NAME IS TESTIT 52303 THREADED ROD ROD 3/8MY NAME IS TESTIT 52303 THREADED ROD MYNAME IS TESTIT 52303 THREADED ROD ROD8-Mar3/88-Mar 43532
CHN14401440 A997080 FLAT SOCK HD CAP SCR 6-40 X 3/81440 A997080 FLAT SOCK HD CAP SCR 6-40 X8-Mar3/88-Mar 43532
TWN14421442 A997082 FLAT SOCK HD CAP SCR 6-40 X 5/81442 A997082 FLAT SOCK HD CAP SCR 6-40 X8-May5/88-May 43593
CHN10231023 -33645-1 SOCK HD 3/4 CAP SCR 7/16-141023 -33645-1 SOCK HD 3/4 CAP SCR7/16/20147/16-147/16/2014 41836
CHN12311231 MP33620-1 SOCK HD 1-1/4 CAP SCR 5/16-181231 MP33620-1 SOCK HD 1-1/4 CAP SCR5/16/20185/16-185/16/2018 43236

<colgroup><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>
 
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
You must log in or register to reply here.

Similar threads

D
  • Question
Completely cleaning account numbers and storing with a specific format
Replies
2
Views
596
diversification
D
G
  • Question
How do I get out of this infinite loop?
Replies
7
Views
363
Fluff
Fluff
P
  • Question
VBA for sending rows of data if column A = current date. (Via email)
Replies
1
Views
386
paun_shotts
P
M
  • Question
Extract data from Word to Excel
Replies
1
Views
1K
MHamid
M
A
  • Question
Combine text from different cells but apply different formatting
Replies
1
Views
971
attikuz
A

Forum statistics

Threads
1,214,649
Messages
6,120,732
Members
448,987
Latest member
marion_davis

Share this page

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