Avoid loop while working with excel to notepad

Question

I use the below code to copy some range from excel to notepad.But its very slow when i work more than 1 lakh (100,000) data . Is there any shorter way to achieve this without using send keys method.

Sub PrintToTextFile()

Dim FileNum As Integer, cl As Range, z As Integer, y As Integer

Dim myStr As String

FileNum = FreeFile ' next free filenumber

'Open "C:\Temp\TEXTFILE.TXT" For Output As #FileNum ' creates the new file

Open "C:\temp\TEXTFILE.TXT" For Append As #FileNum

Print #FileNum, [a1]

z = 10

For Each cl In [b1:b123400]

    y = cl.Row

    If y = z Then

        myStr = myStr & "|" & cl

        'appends the input to an existing file write to the textfile

    Else: Print #FileNum, myStr

        z = cl.Row

        myStr = "": myStr = myStr & "|" & cl

    End If

Next

'appends the input to an existing file write to the textfile

Print #FileNum, myStr

Close #FileNum ' close the file

End Sub

possible duplicate of [How to create and write to a txt file using VBA](http://stackoverflow.com/questions/11503174/how-to-create-and-write-to-a-txt-file-using-vba) — David Zemens, Apr 01 '14 at 18:04
Try the suggestions [here](http://stackoverflow.com/questions/11503174/how-to-create-and-write-to-a-txt-file-using-vba) using FSO and WriteLine methods (still in a loop, but I think should be faster). — David Zemens, Apr 01 '14 at 18:05

Siddharth Rout · Accepted Answer · 2014-04-01T18:24:36.013

TRIED AND TESTED with (1.5 Lakhs i.e 150,000 rows) - Time Taken 1 Second

This should be faster as it doesn't loop through the cells and write to the file at the same time. It makes use of the array.

Sub PrintToTextFile()
    Dim ws As Worksheet
    Dim FileNum As Integer, z As Long, y As Long, i As Long
    Dim myStr As String
    Dim Myar, ArOutput() As String

    '~~> Set this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Myar = ws.Range("b1:b123400").Value

    FileNum = FreeFile ' next free filenumber

    Open "C:\temp\TEXTFILE.TXT" For Append As #FileNum

    Print #FileNum, ws.Range("A1").Value

    z = 10

    For i = LBound(Myar) To UBound(Myar)
        If i = z Then
            myStr = myStr & "|" & Myar(i, 1)
        Else
            ReDim Preserve ArOutput(y)
            ArOutput(y) = myStr
            y = y + 1
            z = i
            myStr = "": myStr = myStr & "|" & Myar(i, 1)
        End If
    Next i

    For i = LBound(ArOutput) To UBound(ArOutput)
        Print #FileNum, ArOutput(i)
    Next i

    'appends the input to an existing file write to the textfile
    Print #FileNum, myStr
    Close #FileNum ' close the file
End Sub

ScreenShot

enter image description here

Code used for above testing.

Sub PrintToTextFile()
    Dim ws As Worksheet
    Dim FileNum As Integer, z As Long, y As Long, i As Long
    Dim myStr As String
    Dim Myar, ArOutput() As String

    Debug.Print "Process Started at " & Now

    '~~> Set this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Myar = ws.Range("B1:B150000").Value

    FileNum = FreeFile ' next free filenumber

    Open "C:\temp1\TEXTFILE.TXT" For Output As #FileNum

    Print #FileNum, ws.Range("A1").Value

    z = 10

    For i = LBound(Myar) To UBound(Myar)
        If i = z Then
            myStr = myStr & "|" & Myar(i, 1)
        Else
            ReDim Preserve ArOutput(y)
            ArOutput(y) = myStr
            y = y + 1
            z = i
            myStr = "": myStr = myStr & "|" & Myar(i, 1)
        End If
    Next i

    For i = LBound(ArOutput) To UBound(ArOutput)
        Print #FileNum, ArOutput(i)
    Next i

    'appends the input to an existing file write to the textfile
    Print #FileNum, myStr
    Close #FileNum ' close the file

    Debug.Print "Process ended at " & Now
End Sub

Avoid loop while working with excel to notepad

1 Answers1