gglgiggles
New Member
- Joined
- Aug 11, 2010
- Messages
- 2
I have a spreadsheet that needs to be shared. I use a query to get data from as database using a stored procedure. My problem is that I need to seperate this data into 4 seperate sheet based upon the data that is returned. I have this working by doing an advanced filter and then doing a copy to the seperate sheets. Unfortunately when I share the workbook, it fails as some limitations exist when a workbook is shared. I am wondering if I can perform a query against the query or is there another suggestion that someone can suggest.
I have included the code although I know it doesn't work in my situation.
Sub filter(crit As String, sht As String)
'
' filter Macro
'
'
'Worksheets("All Data").Range("a4", lastcell).
Worksheets("All Data").Activate
Worksheets("All Data").Range("a4:aj499"). _
AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(crit), _
CopyToRange:=Range("a500"), Unique:=False
Worksheets(sht).Rows("5:500").ClearContents
Worksheets("All Data").Range("a501:aj1000"). _
Copy (Sheets(sht).Range("A5"))
Worksheets("All Data").Rows("500:1000").Delete
End Sub
'Trd_Stl_Today
'Stl_Today
'Stl_GT_Today
'Today_Repo
Sub create_query()
Dim oCn 'As ADODB.Connection
Dim oRS 'As ADODB.Recordset
Dim ConnString As String
Dim SQL As String
Dim qt As QueryTable
ConnString = "DSN=NYPD_PRICEADV"
Set oCn = CreateObject("ADODB.Connection")
oCn.ConnectionString = ConnString
oCn.Open
SQL = "call ap.block_blotter();"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Source = SQL
oRS.ActiveConnection = oCn
oRS.Open
Set qt = Worksheet("All Data").ActiveSheet.QueryTables.Add(Connection:=oRS, _
Destination:=Worksheet("All Data").Range("a5"))
qt.Name = "Block Blotter"
qt.FieldNames = False
qt.RowNumbers = False
qt.FillAdjacentFormulas = True
qt.PreserveFormatting = True
qt.RefreshOnFileOpen = False
qt.BackgroundQuery = True
qt.RefreshStyle = xlOverwriteCells
qt.SavePassword = True
qt.SaveAll Data = True
qt.AdjustColumnWidth = False
qt.RefreshPeriod = 2
qt.PreserveColumnInfo = True
qt.BackgroundQuery = True
qt.Refresh
End Sub
Sub start_proc()
Dim loc As Worksheet
Set loc = ActiveSheet
ActiveWorkbook.Save
For Each qt In Worksheets("All Data").QueryTables
qt.Refresh
Next
Call filter("Trd_Stl_Today", "Trd Stl Today")
Call filter("Stl_Today", "Stl Today")
Call filter("Stl_GT_Today", "Stl > Today")
Call filter("Today_Repo", "Today Repo")
loc.Select
'ActiveWorkbook.Save
End Sub
I have included the code although I know it doesn't work in my situation.
Sub filter(crit As String, sht As String)
'
' filter Macro
'
'
'Worksheets("All Data").Range("a4", lastcell).
Worksheets("All Data").Activate
Worksheets("All Data").Range("a4:aj499"). _
AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(crit), _
CopyToRange:=Range("a500"), Unique:=False
Worksheets(sht).Rows("5:500").ClearContents
Worksheets("All Data").Range("a501:aj1000"). _
Copy (Sheets(sht).Range("A5"))
Worksheets("All Data").Rows("500:1000").Delete
End Sub
'Trd_Stl_Today
'Stl_Today
'Stl_GT_Today
'Today_Repo
Sub create_query()
Dim oCn 'As ADODB.Connection
Dim oRS 'As ADODB.Recordset
Dim ConnString As String
Dim SQL As String
Dim qt As QueryTable
ConnString = "DSN=NYPD_PRICEADV"
Set oCn = CreateObject("ADODB.Connection")
oCn.ConnectionString = ConnString
oCn.Open
SQL = "call ap.block_blotter();"
Set oRS = CreateObject("ADODB.Recordset")
oRS.Source = SQL
oRS.ActiveConnection = oCn
oRS.Open
Set qt = Worksheet("All Data").ActiveSheet.QueryTables.Add(Connection:=oRS, _
Destination:=Worksheet("All Data").Range("a5"))
qt.Name = "Block Blotter"
qt.FieldNames = False
qt.RowNumbers = False
qt.FillAdjacentFormulas = True
qt.PreserveFormatting = True
qt.RefreshOnFileOpen = False
qt.BackgroundQuery = True
qt.RefreshStyle = xlOverwriteCells
qt.SavePassword = True
qt.SaveAll Data = True
qt.AdjustColumnWidth = False
qt.RefreshPeriod = 2
qt.PreserveColumnInfo = True
qt.BackgroundQuery = True
qt.Refresh
End Sub
Sub start_proc()
Dim loc As Worksheet
Set loc = ActiveSheet
ActiveWorkbook.Save
For Each qt In Worksheets("All Data").QueryTables
qt.Refresh
Next
Call filter("Trd_Stl_Today", "Trd Stl Today")
Call filter("Stl_Today", "Stl Today")
Call filter("Stl_GT_Today", "Stl > Today")
Call filter("Today_Repo", "Today Repo")
loc.Select
'ActiveWorkbook.Save
End Sub