View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Mohan Mohan is offline
external usenet poster
 
Posts: 22
Default speed up export to text


Also it's killing the CPU - at 100 % (may be that's why it taking so long).
Is there a better way to do this?

Thanks
Mohan

"Mohan" wrote:

Hi
I am exporting the values from Excel to text file (CSV file).
If the total number of rows are few thousands it's OK. But when I have about
50K records, it takes about 45 to 55 minutes. Is there a way to speed up
this export process?

Here is the code I am using (from Erlandsen consulting page) with some
modifications

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Application.ScreenUpdating = False
StopMacro = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row + 1
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row + 1
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If

Open FName For Output Access Write As #FNum

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol

' the line below will replace a blank cell with spaces
'If Cells(RowNdx, ColNdx).Value = "" Then
' CellValue = Chr(34) & Chr(34)

'if you like blank fields to be skipped then use this
'if statement replacing the above if statement
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""

Else
CellValue = Cells(RowNdx, ColNdx).Text
End If

If CellValue < "" Then
WholeLine = WholeLine & CellValue & Sep
End If

Next ColNdx
Application.StatusBar = "Writing row # " & RowNdx & " to file"
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx

Application.ScreenUpdating = True
Close #FNum
Exit Sub

EndMacro:
'On Error GoTo 0
StopMacro = True

If Err.Number = 76 Then
MsgBox "The path specified in the parmsheet does not exist. " & Chr(13) & _
"Please make sure a valid path is specified", vbExclamation
Else
MsgBox "Error encountered " & Err.Number & " - " & Err.Description
End If
Application.ScreenUpdating = True
Close #FNum

End Sub