ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   ideas - Query table refresh (https://www.excelbanter.com/excel-programming/333546-ideas-query-table-refresh.html)

MattShoreson[_34_]

ideas - Query table refresh
 

I have a stored proc returning recs to a worksheet (copy fro
recordset)
I need some formulae at the end of each row

In order to do this I have created a query table with the 'fill dow
formulae in columns adjacent' set to true.

However when retrieving the SProc data and performing the query tabl
refresh via code there is a problem.

The refresh tries to refresh before the SProc data is returned to th
worksheet.
Any ideas on how to avoid this/Better ideas/solutions?

CIA,
Mat

--
MattShoreso
-----------------------------------------------------------------------
MattShoreson's Profile: http://www.excelforum.com/member.php...nfo&userid=347
View this thread: http://www.excelforum.com/showthread.php?threadid=38430


Philip

ideas - Query table refresh
 
Hi,

Is Calculation set to automatic?

One solution that would speed it up is to turn of automatic calculation of
formulae before you refresh the data, and reset it afterwards...

like this:
application.calculation=xlCalculationmanual
getdata
application.calculation=xlCalculationautomatic

I hope I have understood correctly that this is the issue

HTH

Philip
"MattShoreson" wrote:


I have a stored proc returning recs to a worksheet (copy from
recordset)
I need some formulae at the end of each row

In order to do this I have created a query table with the 'fill down
formulae in columns adjacent' set to true.

However when retrieving the SProc data and performing the query table
refresh via code there is a problem.

The refresh tries to refresh before the SProc data is returned to the
worksheet.
Any ideas on how to avoid this/Better ideas/solutions?

CIA,
Matt


--
MattShoreson
------------------------------------------------------------------------
MattShoreson's Profile: http://www.excelforum.com/member.php...fo&userid=3472
View this thread: http://www.excelforum.com/showthread...hreadid=384301



Sean Connolly[_2_]

ideas - Query table refresh
 
Hi Matt,

Sorry, but I'm a bit confused. Are you retrieving data from an external
source or dB via a) a QueryTable object, b) an OLEDB connection and recordset
or; c) both a) and b)?

If I understand your post correctly and it is c) both, I do believe that
there is a better way.

Maybe you could please clarify and/or post the relevant code snippets and I
(or we) will see if we can help you out.

Cheers, Sean.

"MattShoreson" wrote:


I have a stored proc returning recs to a worksheet (copy from
recordset)
I need some formulae at the end of each row

In order to do this I have created a query table with the 'fill down
formulae in columns adjacent' set to true.

However when retrieving the SProc data and performing the query table
refresh via code there is a problem.

The refresh tries to refresh before the SProc data is returned to the
worksheet.
Any ideas on how to avoid this/Better ideas/solutions?

CIA,
Matt


--
MattShoreson
------------------------------------------------------------------------
MattShoreson's Profile: http://www.excelforum.com/member.php...fo&userid=3472
View this thread: http://www.excelforum.com/showthread...hreadid=384301



MattShoreson[_36_]

ideas - Query table refresh
 

I am using both.

The reason for this is the ability for a querytable to automaticall
fill down adjacent columns formulae.

1) So my steps are retrieve sproc to recordset via ado.
2) Recordset to excel worksheet.
3) Querytable based on date returned in step 2.

Code is as follows:

Sub Main(ByVal strXLQT As String, ByVal strDateFrom As String, ByVa
strDateTo As String)
Dim xlTDBook As Excel.Workbook
Dim xlRDBook As Excel.Workbook
Dim strQT As String

Sheets(cstr_SOURCE).Select
Sheets(cstr_SOURCE).Range("MFTPData").ClearContent s
FireSP strDateFrom, strDateTo
strQT = strXLQT
Sheets(cstr_DATA).Select

Application.Calculation = xlCalculationManual
Workbooks.Open Filename:=cstr_PATH & "RD.xls", UpdateLinks:=0
Workbooks("TD.xls").Activate

Range("QT_MFTP").QueryTable.Refresh BackgroundQuery:=False
Application.Calculation = xlCalculationAutomatic
Workbooks("RD.xls").Close True

Range("MFTPData").ClearContents
End Sub

Sub FireSP(ByVal strDateFrom As String, ByVal strDateTo As String)
Dim vParams As Variant
Dim vValues As Variant
Dim rsReturn As ADODB.Recordset

vParams = Array("datef", "datet")
vValues = Array(strDateFrom, strDateTo)
ReturnRSFromSP "sph_brkr_dscl", vParams, vValues
End Sub

Public Sub ReturnRSFromSP(strSP As String, vParams As Variant, vValue
As Variant)
Dim cnSP As ADODB.Connection
Dim cmdSP As ADODB.Command
Dim lCounter As Long
Dim strItem As String
Dim lIndex As Long
Dim rsReturn As ADODB.Recordset

Set cnSP = New ADODB.Connection
cnSP.ConnectionString
"Provider=MSDASQL.1;Database=DBaseName;Password=PW D1;Persist Securit
Info=True;" & _
"User ID=UID1;Data Source=Dbase1"
cnSP.Open
Set cmdSP = New ADODB.Command
cmdSP.ActiveConnection = cnSP
cmdSP.CommandText = strSP
cmdSP.CommandType = adCmdStoredProc
cmdSP.Parameters.Refresh

lCounter = 0

For lCounter = 1 To cmdSP.Parameters.Count - 1
strItem = cmdSP.Parameters(lCounter).Name
For lIndex = 0 To UBound(vParams)
If "@" & vParams(lIndex) = strItem Then
cmdSP.Parameters(lCounter).Value = vValues(lIndex)
Exit For
End If
Next
Next

Set rsReturn = New ADODB.Recordset
With rsReturn
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockBatchOptimistic
.Open cmdSP
End With

Do Until rsReturn Is Nothing
If rsReturn.State = adStateOpen Then
DumpRecordset rsReturn
End If
Set rsReturn = rsReturn.NextRecordset
Loop

Set cmdSP = Nothing

If cnSP.State = adStateOpen Then
cnSP.Close
End If

Set cnSP = Nothing
Set rsReturn = Nothing
End Sub

Sub DumpRecordset(rsName As ADODB.Recordset, Optional lstartpos A
Long)
Dim W As Workbook
Dim nField As Integer
Dim lRowPos As Long

With rsName
For nField = 1 To .Fields.Count
Cells(1, nField).Value = .Fields(nField - 1).Name
Next nField

If .RecordCount = 0 Then
Exit Sub
End If

.MoveFirst
If Not IsEmpty(lstartpos) Then
.Move lstartpos
End If
End With

Sheets(cstr_SOURCE).Cells(2, 1).CopyFromRecordset rsName
End Su

--
MattShoreso
-----------------------------------------------------------------------
MattShoreson's Profile: http://www.excelforum.com/member.php...nfo&userid=347
View this thread: http://www.excelforum.com/showthread.php?threadid=38430


Sean Connolly[_2_]

ideas - Query table refresh
 
Hi Matt,

Thanks for this and I can see what you're doing with the stored procedure.
Maybe I'm missing it, but still don't get the purpose or function of the
query table though - no matter.

I'm also assuming that its not possible or feasible to modify the stored
procedure T-SQL statement on the server to return the additional, calculated
column(s) your after into the original recordset. (e.g. SELECT fieldA,
fieldB, fieldA*fieldB FROM relevant_table WHERE ...). If so, or if you or
your DBA can create another Stored Proc to return ALL the columns that you
require, that would be easier and preferable (IMO).

Nonetheless, I include below some 'quick and dirty' code that will retrieve
the results of a SQL Server parameterized stored procedure into a recordset,
display that recordset on an Excel worksheet and then fill some additional
columns in that row range with formulae of your choosing.

Like I say, the purists amongst us might not describe the code as 'elegant',
but hey, it works and has worked for me <g.

Let me know how you get on or if you need anything else.

Enjoy and HTH, Sean.

----------

Sub OpenSQLCnn()
Dim SQLCnn As ADODB.Connection
Dim SQLCmd As ADODB.Command
Dim SQLRst As ADODB.Recordset
Dim prm(2) As ADODB.Parameter
Dim strCnn As String, strSQL As String
Dim iCol As Integer, fldCount As Integer

strCnn = Empty
strCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security
Info=True;" & _
"Initial Catalog=Northwind;Data Source=localhost"
strSQL = Empty
' This stored procedure is in the SQL Server 2000 Northwind dB.
' It takes 2 parameters (@Beginning_Date and @Ending_Date) and returns
6 fields.
strSQL = strSQL & "dbo.[Employee Sales by Country]"

Set SQLCnn = New ADODB.Connection
Set SQLCmd = New ADODB.Command
Application.StatusBar = "Connecting ..."
With SQLCnn
.CursorLocation = adUseClient
.Open strCnn
End With
With SQLCmd
.ActiveConnection = SQLCnn
.CommandText = strSQL
.CommandType = adCmdStoredProc
Set prm(1) = .CreateParameter("Beginning_Date", adDate, adParamInput)
' Of course, parameter values could be passed to the subroutine or
retrieved from user at run-time.
prm(1).Value = "June 1, 1997"
Set prm(2) = .CreateParameter("Ending_Date", adDate, adParamInput)
prm(2).Value = "June 30, 1997"
For i = 1 To UBound(prm)
.Parameters.Append prm(i)
Next i
End With
Application.StatusBar = "Executing ..."
Set SQLRst = SQLCmd.Execute
ThisWorkbook.Worksheets("Sheet1").Activate
With ThisWorkbook.Worksheets("Sheet1")
.Activate
.UsedRange.EntireColumn.Delete
Application.StatusBar = "Populating ..."
fldCount = SQLRst.Fields.Count
For iCol = 1 To fldCount
.Cells(1, iCol).Value = SQLRst.Fields(iCol - 1).Name
Next
.Cells(2, 1).CopyFromRecordset SQLRst
Application.StatusBar = "Formatting ..."
.Rows(1).Font.Bold = True
.Cells(1, 1).Activate
' Fill down the formulae ...
Application.StatusBar = "Filling Formulae ..."
FillRangeWithFormulae
.UsedRange.Columns.AutoFit
.Cells(1, 1).Activate
End With
Application.StatusBar = "Closing ..."
SQLRst.Close
SQLCnn.Close
Set SQLRst = Nothing
Set SQLCmd = Nothing
Set SQLCnn = Nothing
Application.StatusBar = False
End Sub

Sub FillRangeWithFormulae()
' Insert a formula in the next blank cell to the right of the CurrentRegion
With ActiveCell.CurrentRegion.Resize(1, 1).Offset(1,
ActiveCell.CurrentRegion.Columns.Count)
' Assuming there's a heading row, add a heading for the new column
(or get it from the user)
.Offset(-1, 0).Value = "Commission (%)"
' Insert your required formula . Here's an example ...
.Formula = "=IF(" & .Offset(0, 1 -
ActiveCell.CurrentRegion.Columns.Count).Address(Ro wAbsolute:=False) &
"=""USA"",4%,5%)"
.Copy ' Copy this cell
' and then paste (fill) the formula down all the rows in this column
.Resize(ActiveCell.CurrentRegion.Rows.Count - 1, 1).PasteSpecial
(xlPasteFormulas)
End With
Application.CutCopyMode = False
' And once again using the formula we just filled. (It's not necessary
- just to demonstrate).
With ActiveCell.CurrentRegion.Resize(1, 1).Offset(1,
ActiveCell.CurrentRegion.Columns.Count)
.Offset(-1, 0).Value = "Commission ($)"
.Formula = "=" & .Offset(0, -1).Address(RowAbsolute:=False) & "*" &
..Offset(0, -2).Address(RowAbsolute:=False)
.Copy
.Resize(ActiveCell.CurrentRegion.Rows.Count - 1, 1).PasteSpecial
(xlPasteFormulas)
End With
Application.CutCopyMode = False
End Sub

"MattShoreson" wrote:


I am using both.

The reason for this is the ability for a querytable to automatically
fill down adjacent columns formulae.

1) So my steps are retrieve sproc to recordset via ado.
2) Recordset to excel worksheet.
3) Querytable based on date returned in step 2.

Code is as follows:

Sub Main(ByVal strXLQT As String, ByVal strDateFrom As String, ByVal
strDateTo As String)
Dim xlTDBook As Excel.Workbook
Dim xlRDBook As Excel.Workbook
Dim strQT As String

Sheets(cstr_SOURCE).Select
Sheets(cstr_SOURCE).Range("MFTPData").ClearContent s
FireSP strDateFrom, strDateTo
strQT = strXLQT
Sheets(cstr_DATA).Select

Application.Calculation = xlCalculationManual
Workbooks.Open Filename:=cstr_PATH & "RD.xls", UpdateLinks:=0
Workbooks("TD.xls").Activate

Range("QT_MFTP").QueryTable.Refresh BackgroundQuery:=False
Application.Calculation = xlCalculationAutomatic
Workbooks("RD.xls").Close True

Range("MFTPData").ClearContents
End Sub

Sub FireSP(ByVal strDateFrom As String, ByVal strDateTo As String)
Dim vParams As Variant
Dim vValues As Variant
Dim rsReturn As ADODB.Recordset

vParams = Array("datef", "datet")
vValues = Array(strDateFrom, strDateTo)
ReturnRSFromSP "sph_brkr_dscl", vParams, vValues
End Sub

Public Sub ReturnRSFromSP(strSP As String, vParams As Variant, vValues
As Variant)
Dim cnSP As ADODB.Connection
Dim cmdSP As ADODB.Command
Dim lCounter As Long
Dim strItem As String
Dim lIndex As Long
Dim rsReturn As ADODB.Recordset

Set cnSP = New ADODB.Connection
cnSP.ConnectionString =
"Provider=MSDASQL.1;Database=DBaseName;Password=PW D1;Persist Security
Info=True;" & _
"User ID=UID1;Data Source=Dbase1"
cnSP.Open
Set cmdSP = New ADODB.Command
cmdSP.ActiveConnection = cnSP
cmdSP.CommandText = strSP
cmdSP.CommandType = adCmdStoredProc
cmdSP.Parameters.Refresh

lCounter = 0

For lCounter = 1 To cmdSP.Parameters.Count - 1
strItem = cmdSP.Parameters(lCounter).Name
For lIndex = 0 To UBound(vParams)
If "@" & vParams(lIndex) = strItem Then
cmdSP.Parameters(lCounter).Value = vValues(lIndex)
Exit For
End If
Next
Next

Set rsReturn = New ADODB.Recordset
With rsReturn
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockBatchOptimistic
.Open cmdSP
End With

Do Until rsReturn Is Nothing
If rsReturn.State = adStateOpen Then
DumpRecordset rsReturn
End If
Set rsReturn = rsReturn.NextRecordset
Loop

Set cmdSP = Nothing

If cnSP.State = adStateOpen Then
cnSP.Close
End If

Set cnSP = Nothing
Set rsReturn = Nothing
End Sub

Sub DumpRecordset(rsName As ADODB.Recordset, Optional lstartpos As
Long)
Dim W As Workbook
Dim nField As Integer
Dim lRowPos As Long

With rsName
For nField = 1 To .Fields.Count
Cells(1, nField).Value = .Fields(nField - 1).Name
Next nField

If .RecordCount = 0 Then
Exit Sub
End If

.MoveFirst
If Not IsEmpty(lstartpos) Then
.Move lstartpos
End If
End With

Sheets(cstr_SOURCE).Cells(2, 1).CopyFromRecordset rsName
End Sub


--
MattShoreson
------------------------------------------------------------------------
MattShoreson's Profile: http://www.excelforum.com/member.php...fo&userid=3472
View this thread: http://www.excelforum.com/showthread...hreadid=384301




All times are GMT +1. The time now is 11:49 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com