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
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
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