text split near line end

daviduk001

New Member
Joined
Jan 25, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
I have created VBA import multiple text files into the same sheet and put each file text into one cell
but I found a problem with excel limited to 32,767 characters in one cell.
Then I split files when characters are over the limit and put it into the next row.

Now I have another issue there is the problem is some phrase is split.
I don't want to split the word, I want to split its end of the line of the phrase before over the max character.
Does anyone help with this?

if you required big text files to test please go here and you can download text files

and this is my current code

Dim i As Integer



VBA Code:
Sub ImportTextFiles()

i = 2
SelectMultipleFiles

MsgBox ("Execution Completed...!")

End Sub

Function SelectMultipleFiles()
    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.txt"
        .Filters.Add "Text Files", "*.txt"
        
        If .Show = True Then
            Dim fPath As Variant
            For Each fPath In .SelectedItems
                ImportFile fPath
            Next
        End If
    End With
End Function

Function ImportFile(Path)

    Dim my_file As Integer
    Dim file_name As String
    Dim allText As String
    Dim fso As New Scripting.FileSystemObject
   
    file_name = Path
    'my_file = FreeFile()
    Open file_name For Binary As #1
    allText = Space$(LOF(1))
    Get #1, , allText
    Close #1

    Dim allTxtArr
    
    allTxtArr = SplitString(allText, 32700)
    
    Dim item As Variant
    Dim fileNameWithoutExt As String
    Dim idx As Integer
    
    fileNameWithoutExt = fso.GetBaseName(file_name)
    idx = 1
    
    For Each item In allTxtArr
        
        item = Trim(item)
        If (item <> Empty) Then
            Cells(i, 1).Value = fileNameWithoutExt & idx
            Cells(i, 2).Value = Trim(item)
            i = i + 1
            idx = idx + 1
        End If
    Next
       
    allText = ""
    allTxtArr = Null
    
    
End Function

Public Function SplitString(ByVal str As String, ByVal numOfChar As Long) As String()
    Dim sArr() As String
    Dim nCount As Long
    ReDim sArr(Len(str) \ numOfChar)
    Do While Len(str)
        sArr(nCount) = Left$(str, numOfChar)
        str = Mid$(str, numOfChar + 1)
        nCount = nCount + 1
    Loop
    SplitString = sArr
End Function
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

severynm

Board Regular
Joined
Jan 8, 2021
Messages
64
Office Version
  1. 365
Platform
  1. Windows
So you're looking to split to the next line at the first line break after some arbitrary cut off at like 32750? What if you go to that index, find the index of the next line break Char(10), and then split there. Something like:
VBA Code:
idx = Application.WorksheetFunction.Search(Chr(10), textstring, 35700)
 

daviduk001

New Member
Joined
Jan 25, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Thanks for your comment but its not works for my issue
As I don't want to split word or phrase by limited 32700 characters
for example "Excel" this word split like this
E
xel
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,963
Office Version
  1. 365
Platform
  1. Windows
Hi @daviduk001
Welcome to the Forum
This is an example on how to split a string into multiple parts, with 2 criteria:
1. certain maximum character length (in this example n = 300)
2. split in the end of line.

Note: I populate the string from a cell not from a file just to make it easier to test.

VBA Code:
Sub a1159532a()
'https://www.mrexcel.com/board/threads/text-split-near-line-end.1159532/#post-5626229
Dim k As Long, n As Long, a As Long
Dim tx As String
Dim va

tx = Range("A1").Value
n = 300 'max character

ReDim va(1 To 100000, 1 To 1)
Do

    a = InStrRev(Left(tx, n), vbLf)
    If a = 0 Then Exit Do
    k = k + 1
    va(k, 1) = Left(tx, a - 1)
    tx = Mid(tx, a + 1)

Loop While Len(tx) > n

If Len(tx) > 0 Then k = k + 1: va(k, 1) = tx

Range("C1").Resize(k, 1) = va

End Sub

I put this string in A1 then ran the code
Book1
A
1Of the latter class, though little known outside of France, is Emile Souvestre, who was born in Morlaix, April 15, 1806, and died at Paris July 5, 1854. He was the son of a civil engineer, was educated at the college of Pontivy, and intended to follow his father's career by entering the Polytechnic School. His father, however, died in 1823, and Souvestre matriculated as a law-student at Rennes. But the young student soon devoted himself entirely to literature. His first essay, a tragedy, 'Le Siege de Missolonghi' (1828), was a pronounced failure. Disheartened and disgusted he left Paris and established himself first as a lawyer in Morlaix. Then he became proprietor of a newspaper, and was afterward appointed a professor in Brest and in Mulhouse. In 1836 he contributed
Sheet1


Result
Book1
C
1Of the latter class, though little known outside of France, is Emile Souvestre, who was born in Morlaix, April 15, 1806, and died at Paris July 5, 1854. He was the son of a civil engineer, was educated at the college of Pontivy, and intended to follow his father's career by
2entering the Polytechnic School. His father, however, died in 1823, and Souvestre matriculated as a law-student at Rennes. But the young student soon devoted himself entirely to literature. His first essay, a tragedy, 'Le Siege de Missolonghi' (1828), was a pronounced failure. Disheartened
3and disgusted he left Paris and established himself first as a lawyer in Morlaix. Then he became proprietor of a newspaper, and was afterward appointed a professor in Brest and in Mulhouse. In 1836 he contributed
Sheet1
 

daviduk001

New Member
Joined
Jan 25, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Dear Akuini
Thanks for your comment but this also not helpful for my case
because texts read from the file not a cell in excel sheet
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,963
Office Version
  1. 365
Platform
  1. Windows
because texts read from the file not a cell in excel sheet
I know that. What I mean is my code can be amended to get the text from a file. Basically you need to populate the text to variable "tx", it doesn't matter the text comes from a range or a file. And change n = 300 to suit.
 

daviduk001

New Member
Joined
Jan 25, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Dar Akuini
Thanks for your reply I already tried it with your code and changed the variable with "tx" but not working.
Can you please upload the full code?
Thank you
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,963
Office Version
  1. 365
Platform
  1. Windows
I don't quite understand your code, but try replacing "Public Function SplitString" with this:
VBA Code:
Public Function SplitString(ByVal tx As String, ByVal xz As Long) As String()
'https://www.mrexcel.com/board/threads/text-split-near-line-end.1159532/
Dim g As Long, x As Long
Dim sArr() As String
ReDim sArr(0 To 100000)

        Do
            x = InStrRev(tx, vbLf, xz, vbTextCompare)
            
            If x = 0 Then sArr(g) = tx: Exit Do
                        
            sArr(g) = Left(tx, x - 1)
            tx = Mid(tx, x + 1)
            
            g = g + 1
        Loop Until Len(tx) = 0
    
ReDim Preserve sArr(0 To g)
SplitString = sArr
End Function
 
Solution

daviduk001

New Member
Joined
Jan 25, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Thank you for your help
Now it's working perfectly! and I solve issue this
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,963
Office Version
  1. 365
Platform
  1. Windows
You're welcome, glad to help & thanks for the feedback. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,479
Messages
5,636,574
Members
416,925
Latest member
malamutus

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
Top