Formatting a text file and exporting a text file - vba

Question

I have a Range of data in text file like 102201906000-102201911999-23451 around thousands. i want to create a new text file to create the range into numbers like.
102201906000 23451
102201906001 23451
102201906002 23451
till
102201911999 23451
Keeping the last digit as fixed.
I have made following code.
Private Sub CommandButton21_Click()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim lCol As Long
Dim rngEnd As String
Dim rng1 As String
Dim rng2 As String
Dim x As Long
Dim Num As Range
For Each Num In Range("A1:A" & LastRow)
lCol = ActiveSheet.UsedRange.Columns.Count
rngEnd = Split(Num, "-")(2)
rng1 = Split(Num, "-")(0) - 1
rng2 = Split(Num, "-")(1)
For x = 1 To rng2 - rng1
Cells(x, lCol + 1) = rng1 + x & " " & rngEnd
Next x
Next Num
Application.ScreenUpdating = True
End Sub
But as i have huge data i am unable to use it properly.
Can i get some help on to create a text file itself when i run a macro without using the spreadsheet.
Waiting for expert advises.

Answer 1

Assuming that you have a text file and want to create another textfile where each line like 102201906000-102201911999-23451 is replaced by a number of lines like 102201906000 23451 it is more natural to use VBScript than straight VBA. You can bypass the need to pull the data into Excel (but -- it is written as an Excel macro so you need to call it from Excel. With minor modification you can remove Excel from the loop completely and use pure VBScript).
To use it you have to include a reference to Microsoft Scripting Runtime to your projects (Tools/References in the VBA editor).
Sub ExpandData(inName As String, outName As String)
Dim FSO As New FileSystemObject
Dim tsIn As TextStream
Dim tsOut As TextStream
Dim startNum, endNum, i, line 'variants
On Error GoTo err_handler
Set tsIn = FSO.OpenTextFile(inName, ForReading)
Set tsOut = FSO.OpenTextFile(outName, ForWriting, True)
Do While tsIn.AtEndOfStream = False
line = Split(tsIn.ReadLine, "-")
If UBound(line) = 2 Then
startNum = CDec(line(0))
endNum = CDec(line(1))
For i = startNum To endNum
tsOut.WriteLine i & " " & line(2)
Next i
End If
Loop
tsIn.Close
tsOut.Close
Exit Sub
err_handler:
Debug.Print "I'm confused!"
End Sub
Used like thus (inName must be different from outName):
Sub test()
ExpandData "C:\Programs\test.txt", "C:\Programs\testout.txt"
End Sub

Answer 2

I would attempt to write then all at once. Looping through and examining them individually should not be necessary if they are sequential.
Private Sub CommandButton21_Click()
Application.ScreenUpdating = False
Dim lr As Long, nmbr As Long, bgn As String, nd As String
With Worksheets("Sheet1") '<~~set this worksheet properly!
lr = .Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
nd = .Cells(1, 1).Value2
bgn = left(nd, 7)
nmbr = CLng(Mid(nd, 8, 5))
nd = right(nd, 5)
With .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(lr, 1)
.Formula = "=""" & bgn & """&TEXT(ROW(" & Rows(nmbr).Address(0, 0) & "), ""00000_)"")&""" & nd & """"
.Value = .Value2
End With
End With
Application.ScreenUpdating = True
End Sub
This generate sequential number based upon the ROW function. The prefix and suffix are peeled off the first value in A1 only once and used afterwards as string vars.