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