The trouble is this loop:

While Not rs.EOF


Cells(r, 0) = rs.Fields(1).Value
Cells(r, 1) = rs.Fields(2).Value
Cells(r, 2) = rs.Fields(3).Value
Cells(r, 3) = "source"
r = r + 1


Debug.Print rs.Fields(1).Value

rs.MoveNext
Wend

Look in the help at the GetRows method of the RecordSet.

Using that you would do instead something like this:

Dim arr

'can leave the Transpose out if you don't need it
arr = WorksheetFunction.Transpose(rs.GetRows)

Range(Cells(1), Cells(UBound(arr) + 1, UBound(arr, 2) + 1)) = arr

And that is much faster.


RBS



"ina" wrote in message
oups.com...
Hello I have this function that is very slow and I have although an
error 1004; any suggestion for this issue.

Function GetPriceMonth(ByVal strCode As String)

Dim cmd As ADODB.Command
Dim cndb As ADODB.Connection 'Database connection
Dim rsAssetCode As ADODB.Recordset 'Recordset
Dim retval(10000, 3) As Variant ' this is the array I did to have the
information I decided to do
'if Cells function, and I declared my function () as variant
Dim callfunction As String


Set cndb = GetConnectionADO() 'function to have a connection

Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cndb
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "getMonthPrice"


With cmd
.Parameters.Append .CreateParameter("strCode", adVarChar, _
adParamInput, 30, strCode)
End With

Set rs = cmd.Execute


Dim r As Integer
r = 1

While Not rs.EOF


Cells(r, 0) = rs.Fields(1).Value
Cells(r, 1) = rs.Fields(2).Value
Cells(r, 2) = rs.Fields(3).Value
Cells(r, 3) = "source"
r = r + 1


Debug.Print rs.Fields(1).Value

rs.MoveNext
Wend


'Dim rngNextCell As Range
'Set rngNextCell = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
' ************
'Resize the range to set the retval
' *************
'rngNextCell.Resize(UBound(retval, 1) - LBound(retval, 1) + 1,
UBound(retval, 2) - LBound(retval, 2) + 1).Value = retval

' ************
' call the function
'*************

'GetPriceMonth = retval

callfunction = GetPriceMonth

cndb.Close
Set cmd = Nothing
Set cndb = Nothing

End Function