Quickest way to modify data and insert into new table

B

Bob

Hi all,

I'm trying to import data, modify the data then insert it into a new
table. The code below works fine for it but it takes a really long
time for 15,000 odd records. Is there a way I can speed up the
processing substantially? as it currently takes about 10 minutes and
thats just way too long because there is many of these imports that I
need to do.... I currently insert each record one by one and I imagine
thats where all the processing power is going, running 15,000 SQL
statements, is there a way to put it into an array or another
recordset and speed it up that way etc? any ideas? please let me know
what code I would need.. see my code below as a starting point...
cheers, Bob.

Private Sub LblMenu1Sub1Lbl1_Click()

Dim strFilter As String
Dim strInputFileName As String
Dim State As String
Dim TableName As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim db As DAO.Database
Dim recs As DAO.Recordset
Dim RecordStr As String
Dim GetDate As String
Dim FinalDate As Date
Dim Field1 As String
Dim Field2 As String
Dim Field3 As String
Dim Field4 As String
Dim Field5 As String
Dim Field6 As String
Dim Field7 As String
Dim Field8 As String
Dim Field9 As String
Dim InvestmentGroup As String
Dim InvestmentGroupCode As String
Dim InvestmentOption As String
Dim InvestmentOptionCode As String
Dim DealerGroup As String
Dim DG As String
Dim DealerGroupCode As String
Dim Inflow As Double
Dim Outflow As Double
Dim Netflow As Double
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim RecCount As Integer

DoCmd.SetWarnings (False)

Set db = CurrentDb()

State = "NSW"
TableName = State & " temp"

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)",
"*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Select NSW Spreadsheet file ...", _
Flags:=ahtOFN_HIDEREADONLY)

If TableExists(TableName) = True Then
DoCmd.RunSQL ("drop table [" & TableName & "];")
End If

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9,
TableName, strInputFileName, 0

'Create new Table
If TableExists(State) = True Then
DoCmd.RunSQL ("drop table [" & State & "];")
End If

'Rename Fields
Field1 = "Investment Group Code"
Field2 = "Investment Group"
Field3 = "Investment Option Code"
Field4 = "Investment Option"
Field5 = "Dealer Code"
Field6 = "Dealer Group"
Field7 = "Inflow"
Field8 = "Outflow"
Field9 = "Netflow"

Set tdfNew = db.CreateTableDef(State)

With tdfNew

.Fields.Append .CreateField(Field1, dbText)
.Fields.Append .CreateField(Field2, dbText)
.Fields.Append .CreateField(Field3, dbText)
.Fields.Append .CreateField(Field4, dbText)
.Fields.Append .CreateField(Field5, dbText)
.Fields.Append .CreateField(Field6, dbText)
.Fields.Append .CreateField(Field7, dbCurrency)
.Fields.Append .CreateField(Field8, dbCurrency)
.Fields.Append .CreateField(Field9, dbCurrency)

db.TableDefs.Append tdfNew

Set tdfNew = Nothing

End With

'Begin Cleanup of Temp data

'Remove junk header rows
strSQL1 = "DELETE [" & TableName & "].F4 FROM [" & TableName & "]
WHERE ((([" & TableName & "].F4) Is Null)) OR ((([" & TableName &
"].F4)=' Outflow'));"
DoCmd.RunSQL (strSQL1)

RecordStr = "select * FROM [" & TableName & "];"
Set recs = db.OpenRecordset(RecordStr)

recs.MoveFirst

GetDate = Trim(recs.Fields("F3").Value)
FinalDate = DateValue(GetDate)

recs.Delete

recs.MoveNext

Do While recs.EOF = False

'Test for Investment Group and do not write to new table if true
If Left(recs.Fields("F1").Value, 3) = "[-]" Then
InvestmentGroupCode = Mid(recs.Fields("F1").Value, 4, 4)
InvestmentGroup = Right(recs.Fields("F1").Value,
Len(recs.Fields("F1").Value) - 10)

Else
InvestmentOptionCode = Mid(recs.Fields("F1").Value, 4, 4)
InvestmentOption = Right(recs.Fields("F1").Value,
Len(recs.Fields("F1").Value) - 10)

Select Case InvestmentOption
Case "Cred Suisse Int'l Sh"
InvestmentOption = "Cred Suisse Int Sh"
Case "Platinum Int'l"
InvestmentOption = "Platinum Int"
Case "Perpetual Int'l"
InvestmentOption = "Perpetual Int"
End Select

DealerGroupCode = Right(recs.Fields("F2").Value, 4)
DG = Mid(recs.Fields("F2").Value, 4,
Len(recs.Fields("F2").Value) - 10)

If InStr(DG, "'") <> 0 Then
DealerGroup = Replace(DG, "'", "")
Else
DealerGroup = DG
End If

'Test for NULL Inflow & Outflow Values
If recs.Fields("F3").Value = "NULL" Then
Inflow = Format(0, "Currency")
Else
Inflow = Format(recs.Fields("F3").Value, "Currency")
End If

If recs.Fields("F4").Value = "NULL" Then
Outflow = Format(0, "Currency")
Else
Outflow = Format(recs.Fields("F4").Value, "Currency")
End If

Netflow = Format(Inflow - Outflow, "Currency")

Debug.Print "[NEXT]"
Debug.Print "Investment Group Code: [" & InvestmentGroupCode &
"]"
Debug.Print "Investment Group: [" & InvestmentGroup & "]"
Debug.Print "Investment Option Code: [" & InvestmentOptionCode
& "]"
Debug.Print "Investment Option: [" & InvestmentOption & "]"
Debug.Print "DealerGroupCode: [" & DealerGroupCode & "]"
Debug.Print "DealerGroup: [" & DealerGroup & "]"
Debug.Print "Inflow: [" & Inflow & "]"
Debug.Print "Outflow: [" & Outflow & "]"
Debug.Print "Netflow: [" & Netflow & "]"

strSQL2 = "INSERT INTO " & State & " ([Investment Group Code],
[Investment Group], [Investment Option Code]," & _
" [Investment Option], [Dealer Code], [Dealer Group],
[Inflow], [Outflow], [Netflow])" & _
" SELECT '" & InvestmentGroupCode & "', '" & InvestmentGroup &
"', '" & InvestmentOptionCode & "', '" & InvestmentOption & "', '" & _
DealerGroupCode & "', '" & DealerGroup & "', " & Inflow & ", "
& Outflow & ", " & Netflow & ";"

DoCmd.RunSQL (strSQL2)

End If

recs.MoveNext

Loop

Set recs = Nothing
Set db = Nothing

DoCmd.SetWarnings (True)

End Sub
 
G

George Nicholson

First, simply getting rid of all the debug.prints would speed things up
considerably I would think.

If it was me I would:
1) import the Excel data into an existing, preformatted temp table.
2) run a series of update queries, as necessary, to "clean up" the data
(change values, delete junk records, etc)
3) Run a saved query to append the cleaned data to the "real" table,
coercing datatypes & formats as necessary
4) empty, not delete, the temp table (or make this step 1)

Your junk rows may limit how much preformatting you can do to your temp
table without throwing errors while importing. But you should be able to do
any necessary coercion within the Append query.

One advantage of using an existing temp table is that you can save all your
related queries, both update and appends, rather than burying it in code.
Makes future maintenance a lot easier (not to mention debugging). Just write
the code that runs those queries in the proper sequence with some DoEvents
interspersed.

In any case, you want to replace your record-by-record approach with queries
like #2 & 3 above, whether saved or in code. Looping is killing you.

HTH,


Bob said:
Hi all,

I'm trying to import data, modify the data then insert it into a new
table. The code below works fine for it but it takes a really long
time for 15,000 odd records. Is there a way I can speed up the
processing substantially? as it currently takes about 10 minutes and
thats just way too long because there is many of these imports that I
need to do.... I currently insert each record one by one and I imagine
thats where all the processing power is going, running 15,000 SQL
statements, is there a way to put it into an array or another
recordset and speed it up that way etc? any ideas? please let me know
what code I would need.. see my code below as a starting point...
cheers, Bob.

Private Sub LblMenu1Sub1Lbl1_Click()

Dim strFilter As String
Dim strInputFileName As String
Dim State As String
Dim TableName As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim db As DAO.Database
Dim recs As DAO.Recordset
Dim RecordStr As String
Dim GetDate As String
Dim FinalDate As Date
Dim Field1 As String
Dim Field2 As String
Dim Field3 As String
Dim Field4 As String
Dim Field5 As String
Dim Field6 As String
Dim Field7 As String
Dim Field8 As String
Dim Field9 As String
Dim InvestmentGroup As String
Dim InvestmentGroupCode As String
Dim InvestmentOption As String
Dim InvestmentOptionCode As String
Dim DealerGroup As String
Dim DG As String
Dim DealerGroupCode As String
Dim Inflow As Double
Dim Outflow As Double
Dim Netflow As Double
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim RecCount As Integer

DoCmd.SetWarnings (False)

Set db = CurrentDb()

State = "NSW"
TableName = State & " temp"

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)",
"*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Select NSW Spreadsheet file ...", _
Flags:=ahtOFN_HIDEREADONLY)

If TableExists(TableName) = True Then
DoCmd.RunSQL ("drop table [" & TableName & "];")
End If

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9,
TableName, strInputFileName, 0

'Create new Table
If TableExists(State) = True Then
DoCmd.RunSQL ("drop table [" & State & "];")
End If

'Rename Fields
Field1 = "Investment Group Code"
Field2 = "Investment Group"
Field3 = "Investment Option Code"
Field4 = "Investment Option"
Field5 = "Dealer Code"
Field6 = "Dealer Group"
Field7 = "Inflow"
Field8 = "Outflow"
Field9 = "Netflow"

Set tdfNew = db.CreateTableDef(State)

With tdfNew

.Fields.Append .CreateField(Field1, dbText)
.Fields.Append .CreateField(Field2, dbText)
.Fields.Append .CreateField(Field3, dbText)
.Fields.Append .CreateField(Field4, dbText)
.Fields.Append .CreateField(Field5, dbText)
.Fields.Append .CreateField(Field6, dbText)
.Fields.Append .CreateField(Field7, dbCurrency)
.Fields.Append .CreateField(Field8, dbCurrency)
.Fields.Append .CreateField(Field9, dbCurrency)

db.TableDefs.Append tdfNew

Set tdfNew = Nothing

End With

'Begin Cleanup of Temp data

'Remove junk header rows
strSQL1 = "DELETE [" & TableName & "].F4 FROM [" & TableName & "]
WHERE ((([" & TableName & "].F4) Is Null)) OR ((([" & TableName &
"].F4)=' Outflow'));"
DoCmd.RunSQL (strSQL1)

RecordStr = "select * FROM [" & TableName & "];"
Set recs = db.OpenRecordset(RecordStr)

recs.MoveFirst

GetDate = Trim(recs.Fields("F3").Value)
FinalDate = DateValue(GetDate)

recs.Delete

recs.MoveNext

Do While recs.EOF = False

'Test for Investment Group and do not write to new table if true
If Left(recs.Fields("F1").Value, 3) = "[-]" Then
InvestmentGroupCode = Mid(recs.Fields("F1").Value, 4, 4)
InvestmentGroup = Right(recs.Fields("F1").Value,
Len(recs.Fields("F1").Value) - 10)

Else
InvestmentOptionCode = Mid(recs.Fields("F1").Value, 4, 4)
InvestmentOption = Right(recs.Fields("F1").Value,
Len(recs.Fields("F1").Value) - 10)

Select Case InvestmentOption
Case "Cred Suisse Int'l Sh"
InvestmentOption = "Cred Suisse Int Sh"
Case "Platinum Int'l"
InvestmentOption = "Platinum Int"
Case "Perpetual Int'l"
InvestmentOption = "Perpetual Int"
End Select

DealerGroupCode = Right(recs.Fields("F2").Value, 4)
DG = Mid(recs.Fields("F2").Value, 4,
Len(recs.Fields("F2").Value) - 10)

If InStr(DG, "'") <> 0 Then
DealerGroup = Replace(DG, "'", "")
Else
DealerGroup = DG
End If

'Test for NULL Inflow & Outflow Values
If recs.Fields("F3").Value = "NULL" Then
Inflow = Format(0, "Currency")
Else
Inflow = Format(recs.Fields("F3").Value, "Currency")
End If

If recs.Fields("F4").Value = "NULL" Then
Outflow = Format(0, "Currency")
Else
Outflow = Format(recs.Fields("F4").Value, "Currency")
End If

Netflow = Format(Inflow - Outflow, "Currency")

Debug.Print "[NEXT]"
Debug.Print "Investment Group Code: [" & InvestmentGroupCode &
"]"
Debug.Print "Investment Group: [" & InvestmentGroup & "]"
Debug.Print "Investment Option Code: [" & InvestmentOptionCode
& "]"
Debug.Print "Investment Option: [" & InvestmentOption & "]"
Debug.Print "DealerGroupCode: [" & DealerGroupCode & "]"
Debug.Print "DealerGroup: [" & DealerGroup & "]"
Debug.Print "Inflow: [" & Inflow & "]"
Debug.Print "Outflow: [" & Outflow & "]"
Debug.Print "Netflow: [" & Netflow & "]"

strSQL2 = "INSERT INTO " & State & " ([Investment Group Code],
[Investment Group], [Investment Option Code]," & _
" [Investment Option], [Dealer Code], [Dealer Group],
[Inflow], [Outflow], [Netflow])" & _
" SELECT '" & InvestmentGroupCode & "', '" & InvestmentGroup &
"', '" & InvestmentOptionCode & "', '" & InvestmentOption & "', '" & _
DealerGroupCode & "', '" & DealerGroup & "', " & Inflow & ", "
& Outflow & ", " & Netflow & ";"

DoCmd.RunSQL (strSQL2)

End If

recs.MoveNext

Loop

Set recs = Nothing
Set db = Nothing

DoCmd.SetWarnings (True)

End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Quickest method to take data from a table, modify it and put it in another table 5
Help with Access VBA to create a new file and import textfile data 6
Addind Caption vallue to field in backend table 0
Appending a field to a table -AND- accessing a split back-end data 7
Convert Columns to Rows and insert into another table based on valuesin columns 7
SQL code to insert data from one table into another 5

Top