Quickest method to take data from a table, modify it and put it in another 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
 
A

Allen Browne

Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values that need
to be found and the replacement values, and then outer join this table to
your original. If you could do something like that (and read the replacement
values rather than using the Replace() function), it might be possible to do
the entire thing in one SQL statement.

--
Allen Browne - Microsoft MVP. Perth, Western Australia

Reply to group, rather than allenbrowne at mvps dot org.

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

Bob

Hi Allen,

so how would I do that?

Cheers,

Bob

Allen said:
Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values that need
to be found and the replacement values, and then outer join this table to
your original. If you could do something like that (and read the replacement
values rather than using the Replace() function), it might be possible to do
the entire thing in one SQL statement.

--
Allen Browne - Microsoft MVP. Perth, Western Australia

Reply to group, rather than allenbrowne at mvps dot org.

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...
Click to expand...
 
A

Allen Browne

Can't give you all that in detail, Bob, but the idea is a column with 2
tables:
What2Find What2ReplaceWith

Outer join this table to the field you need to replace on.
If there's a match, you use the value from the What2ReplaceWith field
instead, so:
Nz([What2ReplaceWith], [What2Find])

--
Allen Browne - Microsoft MVP. Perth, Western Australia

Reply to group, rather than allenbrowne at mvps dot org.

Bob said:
Hi Allen,

so how would I do that?

Cheers,

Bob

Allen said:
Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values that
need
to be found and the replacement values, and then outer join this table to
your original. If you could do something like that (and read the
replacement
values rather than using the Replace() function), it might be possible to
do
the entire thing in one SQL statement.

--
Allen Browne - Microsoft MVP. Perth, Western Australia

Reply to group, rather than allenbrowne at mvps dot org.

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...
Click to expand...
Click to expand...
 
B

Bob

Hi Allen,

Is it possible to create an array, load the new records in as I'm
doing the data manipulation, then dump that entire dataset to a new
table to speed up processing time?

Allen said:
Can't give you all that in detail, Bob, but the idea is a column with 2
tables:
What2Find What2ReplaceWith

Outer join this table to the field you need to replace on.
If there's a match, you use the value from the What2ReplaceWith field
instead, so:
Nz([What2ReplaceWith], [What2Find])

--
Allen Browne - Microsoft MVP. Perth, Western Australia

Reply to group, rather than allenbrowne at mvps dot org.

Bob said:
Hi Allen,

so how would I do that?

Cheers,

Bob

Allen said:
Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values that
need
to be found and the replacement values, and then outer join this table to
your original. If you could do something like that (and read the
replacement
values rather than using the Replace() function), it might be possible to
do
the entire thing in one SQL statement.

--
Allen Browne - Microsoft MVP. Perth, Western Australia

Reply to group, rather than allenbrowne at mvps dot org.

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...
Click to expand...
Click to expand...
 
A

Allen Browne

Yes, you could use code to loop through all records in the source, and for
each one loop through all items in the array, replacing the items if found.
But I suspect doing it in a query would be more efficient if that suits what
you are doing.
--
Allen Browne - Microsoft MVP. Perth, Western Australia

Reply to group, rather than allenbrowne at mvps dot org.

Bob said:
Hi Allen,

Is it possible to create an array, load the new records in as I'm
doing the data manipulation, then dump that entire dataset to a new
table to speed up processing time?

Allen said:
Can't give you all that in detail, Bob, but the idea is a column with 2
tables:
What2Find What2ReplaceWith

Outer join this table to the field you need to replace on.
If there's a match, you use the value from the What2ReplaceWith field
instead, so:
Nz([What2ReplaceWith], [What2Find])

Bob said:
Hi Allen,

so how would I do that?

Cheers,

Bob

Allen Browne wrote:
Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values
that
need
to be found and the replacement values, and then outer join this table
to
your original. If you could do something like that (and read the
replacement
values rather than using the Replace() function), it might be possible
to
do
the entire thing in one SQL statement.

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...
Click to expand...
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 way to modify data and insert into new table 1
export table and give it a name from the value in another unbound table 1

Top