Copy and Transpose

[eggpap]

I use a wb as input interface to save the data on some mdb files at th
end of the Excel session. The retrieving or saving data task from Acces
to Excel and viceversa, however, is very slow so I am trying to get
faster routine.

Currently, to retrieve the data, I read ADO recordsets and assign th
fields value to the target ranges. To save to Access, viceversa,
append/update validating the recordset fields with the cell values.

To retrieve (and similarly to save) the data, I have tested th
following routine: since the Access tables are transposed respect to th
ranges I need to populate, I import the table on a sheet by th
CopyFromRecordset method, select the data range, copy the selection an
PasteSpecial it transposed on the range I need. *Surprisingly the resul
I get is slower than that currently used!!*.

Here is the routine I use to Retrieve the Data form Access...

Sub RetrevingData(month as long)
'
' here other not interesting instructions
'
M = CLng(month)
ID = ID_filter
Year = Range("1Trim!AO1").Value

Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.jet.OLEDB.4.0"
.Properties("Data Source") = appath & "people.mdb"
.Properties("Jet OLEDBatabase Password") = PWORD
.Open
End With
Set rs = New ADODB.Recordset
'SQLstr = "SELECT tb1.*, Year([Data1]) AS Y, Month([Data1]) AS M
tb1.CID FROM tb1 WHERE " _
'& "(((Year([Data1]))=" & Year & ") AND ((Month([Data1]))=" & Mont
& " ) AND ((tb1.CID)=" & ID & "));"

SQLstr = "SELECT tb1.T, tb1.V, tb1.A, tb1.P, tb1.S, tb1.R " _
& "FROM tb1 WHERE (((Year([Data1]))=" & Year & ") AN
((Month([Data1]))=" & M & ") AND ((tb1.CID)=" & ID & "));"

With rs
.Open SQLstr, cn, 3, 3, adCmdText

Sheets("LoadData").Activate
Sheets("LoadData").Select
Range("DataZone").Select
Range("DataZone").Clear
Range("LoadData!A1").CopyFromRecordset rs
Select Case M
Case 1, 4, 7, 10
Call CopYAndTranspose(Range("DataZone"), M, "C6")
Case 2, 5, 8, 11
Call CopyAbdTranspose(Range("DataZone"), M, "C19")
Case 3, 6, 9, 12
Call CopyAndTranspose(Range("DataZone"), M, "C32")
End Select
End With
closers1:
rs.Close
Set rs = Nothing
...
...
End Sub

Sub CopyAndTraspose(rngData As Range, month As Long, celltrg A
String)
'where rngData is the table copied from recordset
'month (I've three months on 4 sheets)
'celltrg is the first cell of the target range
'
On Error GoTo err_hnd
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
rngData.Select
Selection.Copy
Select Case month
Case 1, 2, 3
Sheets("1Trim").Activate
Sheets("1trim").Select
Case 4, 5, 6
Sheets("2Trim").Activate
Sheets("2trim").Select
Case 7, 8, 9
Sheets("3Trim").Activate
Sheets("3trim").Select
Case 10, 11, 12
Sheets("4Trim").Activate
Sheets("4trim").Select
End Select
Range(celltrg).Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
err_hnd:
MsgBox Err.Description & " " & Err.Number, vbOKOnly & " Su
CopyAndTraspose"
Resume Next
End Sub

Someone has a tip for me?
Emilian

 

[Per Jessen]

Hi

Don't use sheets(sh).activate and sheets(sh).select,
one of theese statements will do it.

But to make it faster don't use select or activate at all.

This is doing the same as your code:

Dim TargetSh As Worksheet
On Error GoTo err_hnd
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
rngData.Copy
Select Case month
Case 1, 2, 3
Set TargetSh = Worksheets("1trim")
Case 4, 5, 6
Set TargetSh = Worksheets("2Trim")
Case 7, 8, 9
Set TargetSh = Worksheets("3trim")
Case 10, 11, 12
Set TargetSh = Worksheets("4Trim")
End Select
TargetSh.Range(celltrg).PasteSpecial Paste:=xlPasteValues,
Transpose:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
err_hnd:
MsgBox Err.Description & " " & Err.Number, vbOKOnly & " Sub
CopyAndTraspose "
Resume Next

Hopes this helps.

---
Per

I use a wb as input interface to save the data on some mdb files at the
end of the Excel session. The retrieving or saving data task from Access
to Excel and viceversa, however, is very slow so I am trying to get a
faster routine.

Currently, to retrieve the data, I read ADO recordsets and assign the
fields value to the target ranges. To save to Access, viceversa, I
append/update validating the recordset fields with the cell values.

To retrieve (and similarly to save) the data, I have tested the
following routine: since the Access tables are transposed respect to the
ranges I need to populate, I import the table on a sheet by the
CopyFromRecordset method, select the data range, copy the selection and
PasteSpecial it transposed on the range I need. *Surprisingly the result
I get is slower than that currently used!!*.

Here is the routine I use to Retrieve the Data form Access...

Sub RetrevingData(month as long)
'
' here other not interesting instructions
'
M = CLng(month)
ID = ID_filter
Year = Range("1Trim!AO1").Value

Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.jet.OLEDB.4.0"
.Properties("Data Source") = appath & "people.mdb"
.Properties("Jet OLEDBatabase Password") = PWORD
.Open
End With
Set rs = New ADODB.Recordset
'SQLstr = "SELECT tb1.*, Year([Data1]) AS Y, Month([Data1]) AS M,
tb1.CID FROM tb1 WHERE " _
'& "(((Year([Data1]))=" & Year & ") AND ((Month([Data1]))=" & Month
& " ) AND ((tb1.CID)=" & ID & "));"

SQLstr = "SELECT tb1.T, tb1.V, tb1.A, tb1.P, tb1.S, tb1.R " _
& "FROM tb1 WHERE (((Year([Data1]))=" & Year & ") AND
((Month([Data1]))=" & M & ") AND ((tb1.CID)=" & ID & "));"

With rs
.Open SQLstr, cn, 3, 3, adCmdText

Sheets("LoadData").Activate
Sheets("LoadData").Select
Range("DataZone").Select
Range("DataZone").Clear
Range("LoadData!A1").CopyFromRecordset rs
Select Case M
Case 1, 4, 7, 10
Call CopYAndTranspose(Range("DataZone"), M, "C6")
Case 2, 5, 8, 11
Call CopyAbdTranspose(Range("DataZone"), M, "C19")
Case 3, 6, 9, 12
Call CopyAndTranspose(Range("DataZone"), M, "C32")
End Select
End With
closers1:
rs.Close
Set rs = Nothing
..
..
End Sub

Sub CopyAndTraspose(rngData As Range, month As Long, celltrg As
String)
'where rngData is the table copied from recordset
'month (I've three months on 4 sheets)
'celltrg is the first cell of the target range
'
On Error GoTo err_hnd
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
rngData.Select
Selection.Copy
Select Case month
Case 1, 2, 3
Sheets("1Trim").Activate
Sheets("1trim").Select
Case 4, 5, 6
Sheets("2Trim").Activate
Sheets("2trim").Select
Case 7, 8, 9
Sheets("3Trim").Activate
Sheets("3trim").Select
Case 10, 11, 12
Sheets("4Trim").Activate
Sheets("4trim").Select
End Select
Range(celltrg).Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
err_hnd:
MsgBox Err.Description & " " & Err.Number, vbOKOnly & " Sub
CopyAndTraspose"
Resume Next
End Sub

Someone has a tip for me?
Emiliano

 

[eggpap]

Many thanks for your precious tips.
I'ld like to vote or to say thanks to your reply, but I don't know ho
to do it.

Emilian

 

[eggpap]

Hello,

I've tested your tips, but the old procedure is much faster than th
new.
Do you know other techniques of retrieving/saving data from Access t
Excel and viceversa?

I'ld like, moreover, to learn the best Excel programming technique
(use of objects etc.). Have you some usefull links?

Finally, after

set ws = worksheets("name")

must I use

set ws = nothing

before the End Sub ?

Thanks Emilian