Copy all text between numbers from a text file to Excel sheet rows.

[sr1111]

Copy all text between numbers from a text file to Excel sheet rows.
attached:
Text.txt (Input) shown as image

Excel file (Output)

key1.xlsx
	A
1
2	1. How to copy text in key:1# rows betwen numbers from a text file. How to copy text in rows betwen numbers from a text file. How to copy text in rows betwen numbers from a text file. How to copy text in rows betwen numbers from a text file.
3	3. How to copy text in rows betwen numbers from a key:1# text file. How to copy text in rows betwen numbers from a text file.
4	5. How to copy key:1# text in rows betwen numbers from a text file . How to copy text in rows betwen numbers from a text file 8090. How to copy text in rows betwen numbers from a text file How to copy text in rows betwen numbers from a text file 8090. How to copy text in rows betwen numbers from a text file How to copy text in rows betwen numbers from a text file 8090. How to copy text in rows betwen numbers from a text file 8090. How to copy text in rows betwen numbers from a text file
5	100. How to copy text key:1# in rows betwen numbers from a text file August 10 . How to copy text in rows betwen numbers from a text file
6	200. key:1# 20. How to copy text in rows betwen numbers from a text file How to copy text in rows betwen numbers from a text file
Sheet1

 

[cmowla]

Hi.

Let me know if this works for you. To test it, simply put all of this code in it's own standard VBA module, change the filePath and sheetName to what they need to be in the top sub, and then run the top sub. It starts putting data in row 2 in column A, but as you can see, you can change both the column letter and the start row number too. (I used regular expressions.)

Option Explicit

Sub Copy_Text_Between_Numbers_In_Text_File_To_Worksheet()
Dim s1$, s2$, filePath$, sheetName$, starts() As String, i&, columnLetter$, rowNumber&

columnLetter = "A"
rowNumber = 2
filePath = "C:\Users\Chris\Desktop\Sample File.txt"
sheetName = ActiveSheet.Name

s1 = Put_All_Data_In_A_Text_File_Into_A_String(filePath)
s2 = s1 'Passing s1 in the following function modifies it, so we make a copy.
starts = Split(List_Of_Start_Locations(s1, "[0-9]+[.]"), ",")

Application.Calculation = xlCalculationManual
For i = 0 To UBound(starts) - 1
    Sheets(sheetName).Range(columnLetter & i + rowNumber).Value = SubString(s2, CLng(starts(i)), CLng(starts(i + 1) - 1))
Next i
Sheets(sheetName).Range(columnLetter & i + rowNumber).Value = SubString(s2, CLng(starts(i)), Len(s2))
Application.Calculation = xlCalculationAutomatic

End Sub
Function List_Of_Start_Locations(strValue$, strPattern$) As String
Dim str1$, counter%, i&, finish&, previousFinish&, location&
counter = 0: previousFinish = 0
str1 = strValue: List_Of_Start_Locations = "1"
With CreateObject("VBScript.RegExp")
    .Pattern = strPattern
    .IgnoreCase = True
start:
    If .test(strValue) = True Then
        counter = counter + 1
        location = .Execute(strValue)(0).firstindex + 1
        strValue = .Replace(strValue, "ß")
        strValue = SubString(strValue, InStr(strValue, "ß") + 1, Len(strValue))
        If counter > 1 Then
            finish = previousFinish + location
            i = 1
            Do While Consists_Of_Only_Numberical_Digits(SubString(str1, finish + i, finish + i)) = False
                i = i + 1
            Loop
            finish = finish + i - 1
            List_Of_Start_Locations = List_Of_Start_Locations & "," & finish + 1
            previousFinish = finish
        End If
        GoTo start
    End If
End With

End Function
Function Consists_Of_Only_Numberical_Digits(strValue As String) As Boolean
Consists_Of_Only_Numberical_Digits = strValue Like WorksheetFunction.Rept("[0-9]", Len(strValue))
End Function
Function Put_All_Data_In_A_Text_File_Into_A_String(filePath As String)
With CreateObject("Scripting.FileSystemObject").OpenTextFile(filePath)
    Put_All_Data_In_A_Text_File_Into_A_String = .ReadAll
    .Close
End With
End Function
Function SubString(str As String, start As Long, finish As Long)
On Error Resume Next
SubString = Mid(str, start, finish - start + 1)
End Function

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

How to copy text in excel cell in rows between numbers from a text file.

How to copy the text in excel cells in rows between numbers from a text file. The last line does not have a number. There are thousands of numbers. Text in text.txt file Example 1. How to copy the text in rows between numbers from a text file. How to copy the text in rows between...

www.excelforum.com

Copy text in excel cell in rows between numbers from a big text file - OzGrid Free Excel/VBA Help Forum

When I ran the below code with a text file above 20 MB from my excel file, I get an Error showing "L = Val(X)" in yellow, and run-time error type mismatch 13 popped up.First I posted it at https://www.excelforum.com/exc…ext-file.html#post5724130 but more…

forum.ozgrid.com

If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[sr1111]

Hi.

Let me know if this works for you. To test it, simply put all of this code in it's own standard VBA module, change the filePath and sheetName to what they need to be in the top sub, and then run the top sub. It starts putting data in row 2 in column A, but as you can see, you can change both the column letter and the start row number too. (I used regular expressions.)

Option Explicit

Sub Copy_Text_Between_Numbers_In_Text_File_To_Worksheet()
Dim s1$, s2$, filePath$, sheetName$, starts() As String, i&, columnLetter$, rowNumber&

columnLetter = "A"
rowNumber = 2
filePath = "C:\Users\Chris\Desktop\Sample File.txt"
sheetName = ActiveSheet.Name

s1 = Put_All_Data_In_A_Text_File_Into_A_String(filePath)
s2 = s1 'Passing s1 in the following function modifies it, so we make a copy.
starts = Split(List_Of_Start_Locations(s1, "[0-9]+[.]"), ",")

Application.Calculation = xlCalculationManual
For i = 0 To UBound(starts) - 1
    Sheets(sheetName).Range(columnLetter & i + rowNumber).Value = SubString(s2, CLng(starts(i)), CLng(starts(i + 1) - 1))
Next i
Sheets(sheetName).Range(columnLetter & i + rowNumber).Value = SubString(s2, CLng(starts(i)), Len(s2))
Application.Calculation = xlCalculationAutomatic

End Sub
Function List_Of_Start_Locations(strValue$, strPattern$) As String
Dim str1$, counter%, i&, finish&, previousFinish&, location&
counter = 0: previousFinish = 0
str1 = strValue: List_Of_Start_Locations = "1"
With CreateObject("VBScript.RegExp")
    .Pattern = strPattern
    .IgnoreCase = True
start:
    If .test(strValue) = True Then
        counter = counter + 1
        location = .Execute(strValue)(0).firstindex + 1
        strValue = .Replace(strValue, "ß")
        strValue = SubString(strValue, InStr(strValue, "ß") + 1, Len(strValue))
        If counter > 1 Then
            finish = previousFinish + location
            i = 1
            Do While Consists_Of_Only_Numberical_Digits(SubString(str1, finish + i, finish + i)) = False
                i = i + 1
            Loop
            finish = finish + i - 1
            List_Of_Start_Locations = List_Of_Start_Locations & "," & finish + 1
            previousFinish = finish
        End If
        GoTo start
    End If
End With

End Function
Function Consists_Of_Only_Numberical_Digits(strValue As String) As Boolean
Consists_Of_Only_Numberical_Digits = strValue Like WorksheetFunction.Rept("[0-9]", Len(strValue))
End Function
Function Put_All_Data_In_A_Text_File_Into_A_String(filePath As String)
With CreateObject("Scripting.FileSystemObject").OpenTextFile(filePath)
    Put_All_Data_In_A_Text_File_Into_A_String = .ReadAll
    .Close
End With
End Function
Function SubString(str As String, start As Long, finish As Long)
On Error Resume Next
SubString = Mid(str, start, finish - start + 1)
End Function

Nope the VBA has not given the result as shown in the "Excel file (Output)" above.