poor macro performance
 

I have a macro to read in the a comma seperated value (CSV) file and
set the data into a named range. The file format is
<range_name,<numeric value. The problem is that the macro takes about
8 minutes to read 34000 records and seems to gradually slow down.
This would lead me to believe I have a memory leak of some kind. Most
of the time is split evenly between two functions
1) getRangeAddress2() to get the worksheet name range
2) Range(ra) = dprecord(1) to set the actual range value.

Any suggestions?
Paul
-------------------------------------------------------------------
Public Sub readDatapoints()
'Macro readDataPoints
'This macro will read in the a comma seperated value (CSV) file of
datapoints
'and set the data into a named range.

Dim sFile As String
Dim currentLine As String
Dim delimit As String
Dim counter As Integer
Dim ra As String
Dim fs As Object
Dim ts As Object
Dim dprecord

Dim oldStatusBar As Boolean

delimit = ","

'prompt user for file
sFile = Application.GetOpenFilename(fileFilter:="CSV Comma
delimited (*.csv), *.csv", Title:="BCAR data")
If Not Len(Dir(sFile)) 0 Or sFile = "False" Then
Exit Sub
End If

'We turn off calculation and screenupdating to speed up the macro.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(sFile, 1, False)

currentLine = ts.ReadLine

oldStatusBar = Application.DisplayStatusBar

' Continues reading lines until there are no more.
While (Not ts.AtEndOfStream)

'give the user something to look at
If counter Mod 100 = 0 Then
Application.StatusBar = "loading BCAR data" &
String(counter / 100, ".")
End If

'parse the record
dprecord = Split(currentLine, delimit)

'read in the records and set the referenced range value
If UBound(dprecord) 0 And Len(dprecord(1)) 0 Then
' get the range address
ra = getRangeAddress2("DPA_" & CStr(dprecord(0)))

'set the value for the incoming record
If Len(ra) 0 Then
Range(ra) = dprecord(1)
End If
End If

currentLine = ts.ReadLine
counter = counter + 1
Wend

Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Function getRangeAddress2(rname As String) As String
Dim c As Range
Dim returnStr As String

'''''''''''''''''''''''''''''''''''
' find the datapoint address name
''''''''''''''''''''''''''''''''''
'Dim lookuprange As Range
'Set lookuprange =
Worksheets("DPA_Control").Range("DPAControl_Range" )
'returnStr = Application.WorksheetFunction.VLookup(rname,
lookuprange, 2, False)

Set c = Worksheets("DPA Control").Cells.Find(What:=rname,
LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)



'if found, build and return address
If Not c Is Nothing Then
returnStr = c.Offset(0, 1).Value
returnStr = "='" & Replace(returnStr, "'", "''") & "'!" & rname
End If

Set c = Nothing

getRangeAddress2 = returnStr


End Function

poor macro performance
 

open the file in Excel,
put down a Vlookup formula to get the address

Pick it all up in an array

Do the writing, or if it will be a contiguous destination, line up you data
and put it all down at once.

When I say put down a vlookup formula, I mean something like

Range("C1:C34000").Formula = "=Vlookup(A1,DPA_ControlRange,2,False)"

Do as much as you can all at once (as above and below)

v = Range("A1:C34000).Value

--
Regards,
Tom Ogilvy


" wrote:

I have a macro to read in the a comma seperated value (CSV) file and
set the data into a named range. The file format is
<range_name,<numeric value. The problem is that the macro takes about
8 minutes to read 34000 records and seems to gradually slow down.
This would lead me to believe I have a memory leak of some kind. Most
of the time is split evenly between two functions
1) getRangeAddress2() to get the worksheet name range
2) Range(ra) = dprecord(1) to set the actual range value.

Any suggestions?
Paul
-------------------------------------------------------------------
Public Sub readDatapoints()
'Macro readDataPoints
'This macro will read in the a comma seperated value (CSV) file of
datapoints
'and set the data into a named range.

Dim sFile As String
Dim currentLine As String
Dim delimit As String
Dim counter As Integer
Dim ra As String
Dim fs As Object
Dim ts As Object
Dim dprecord

Dim oldStatusBar As Boolean

delimit = ","

'prompt user for file
sFile = Application.GetOpenFilename(fileFilter:="CSV Comma
delimited (*.csv), *.csv", Title:="BCAR data")
If Not Len(Dir(sFile)) 0 Or sFile = "False" Then
Exit Sub
End If

'We turn off calculation and screenupdating to speed up the macro.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(sFile, 1, False)

currentLine = ts.ReadLine

oldStatusBar = Application.DisplayStatusBar

' Continues reading lines until there are no more.
While (Not ts.AtEndOfStream)

'give the user something to look at
If counter Mod 100 = 0 Then
Application.StatusBar = "loading BCAR data" &
String(counter / 100, ".")
End If

'parse the record
dprecord = Split(currentLine, delimit)

'read in the records and set the referenced range value
If UBound(dprecord) 0 And Len(dprecord(1)) 0 Then
' get the range address
ra = getRangeAddress2("DPA_" & CStr(dprecord(0)))

'set the value for the incoming record
If Len(ra) 0 Then
Range(ra) = dprecord(1)
End If
End If

currentLine = ts.ReadLine
counter = counter + 1
Wend

Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Function getRangeAddress2(rname As String) As String
Dim c As Range
Dim returnStr As String

'''''''''''''''''''''''''''''''''''
' find the datapoint address name
''''''''''''''''''''''''''''''''''
'Dim lookuprange As Range
'Set lookuprange =
Worksheets("DPA_Control").Range("DPAControl_Range" )
'returnStr = Application.WorksheetFunction.VLookup(rname,
lookuprange, 2, False)

Set c = Worksheets("DPA Control").Cells.Find(What:=rname,
LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)



'if found, build and return address
If Not c Is Nothing Then
returnStr = c.Offset(0, 1).Value
returnStr = "='" & Replace(returnStr, "'", "''") & "'!" & rname
End If

Set c = Nothing

getRangeAddress2 = returnStr


End Function