I'm creating automated pivottables from a pivotcache which imports its recordset form an adodb connection.
I need to group the date field and found a way online to do it with the .pivotselect method. The code works fine, however excel does not seem to select the worksheet where the pivottables are somehow, even though the pivottable data is selected. This leads to an error if one select another sheet and then runs the procedure.
Shouldn't pivottable.pivotselect select the sheet also automatically? I have solved it temporarily by having sheets("Pivot").select just before the date grouping code. How may one come around this problem? The current code is based on code generated from macro recorder.
Code
Private Sub PivotAccessADODB()
' Link Pivottable to access database, successfull!
Const ConnectionPath As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\name\Desktop\DataBase.accdb;Persist Security Info=False;"
Dim DataConnection As ADODB.Connection: Set DataConnection = New ADODB.Connection
Dim RecordSet As ADODB.RecordSet: Set RecordSet = New ADODB.RecordSet
DataConnection.ConnectionString = ConnectionPath
DataConnection.Open
Dim SQLString As String: SQLString = "SELECT * FROM ALFA"
With RecordSet
.ActiveConnection = DataConnection
.Source = SQLString
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
' Initiate accept of external data
Dim PTCache As PivotCache
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set PTCache.RecordSet = RecordSet
'----------------------------------'
'First Pivot Table export procedure
Dim PT As PivotTable: Set PT = PTCache.CreatePivotTable(Sheets("Pivot").Range("A1"), "PivotTable#1")
With PT
.PivotFields("Date").Orientation = xlRowField
.PivotFields("Date").Position = 1
Sheets("pivot").Select ' Bypass selection grouping error, temporary solution as of 2014-12-26
PT.PivotSelect "Date[All]", xlLabelOnly + xlFirstRow, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, False, False)
.PivotFields("Adj Close").Orientation = xlDataField
.PivotFields("Sum of Adj Close").Calculation = xlPercentDifferenceFrom
.PivotFields("Sum of Adj Close").BaseItem = "(previous)"
.PivotFields("Volume").Orientation = xlDataField
.PivotFields("Sum of Volume").Calculation = xlPercentDifferenceFrom
.PivotFields("Sum of Volume").BaseItem = "(previous)"
End With
Dim wst As Worksheet: Set wst = Sheets("Mainwindow")
Dim wshape As Shape
Set wshape = wst.Shapes.AddChart2(286, xl3DColumnClustered, wst.Range("A24").Left, wst.Range("A24").Top, _
wst.Range("A24:Q24").Width, wst.Range("A24:A39").Height)
With wshape.Chart
.SetSourceData Source:=PT.TableRange1
.ClearToMatchStyle
.ChartStyle = 291
.ApplyLayout (1)
.ChartTitle.Text = "Difference from previous month in percentage"
.ChartTitle.Format.TextFrame2.TextRange.Font.Size = 14
End With
'-----------------------------------'
'Second Pivot Table export procedure'
'Cleanup
RecordSet.Close
DataConnection.Close
Set RecordSet = Nothing
Set DataConnection = Nothing
End Sub
Be sure to dimension a Worksheet object and set it to the whatever worksheet has the pivot tables:
Dim wkb As Excel.Workheet
Set wkb = ActiveWorkbook.Worksheet("Me")
wkb.Activate 'wkb.Select may give focus but doesn't register as the active worksheet object.
<PT Code>
Set wkb = Nothing
Related
I have a data connection in my xlsm file, which is called "DATA".
I created my combo box and input the value from a range.
Now I need to return a result set based on the value from the combo box (drop down list). e.g. if the value in the dropdown list is "CompanyXYZ", then my query from "DATA" needs to be returned but only the data for CompanyXYZ.
The sql equivalent is:
"SELECT * FROM [query] where [column] = combobox
Issue #1
Below is my sheet("DATA"). It has a table returned by the SQL query. One of the columns is Debtor_Name. It has more than 8500 rows but only 90 are unique.
In my other sheet, I have an ActiveX ComboBox that needs to return all the unique values from DATA.Debtor_name column (the 90 unique values).
Sample VBA for issue #1:
Sub Populate_Combobox_Worksheet()
'The Excel workbook and worksheets that contain the data, as well as the range placed on that data
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
'Variant to contain the data to be placed in the combo box.
Dim vaData As Variant
'Initialize the Excel objects
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("DATA")
'Set the range equal to the data, and then (temporarily) copy the unique values of that data to the L column.
With wsSheet
Set rnData = .Range(.Range("D1"), .Range("D10000").End(xlUp))
rnData.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("X1"), _
Unique:=True
'store the unique values in vaData
vaData = .Range(.Range("X2"), .Range("X10000").End(xlUp)).Value
'clean up the contents of the temporary data storage
.Range(.Range("X1"), .Range("X10000").End(xlUp)).ClearContents
End With
'display the unique values in vaData in the combo box already in existence on the worksheet.
With wsSheet.OLEObjects("ComboBox1").Object
.Clear
.List = vaData
.ListIndex = -1
End With
End Sub
Issue #2.
Now the end user will need to select a debtor_name from the combo box, then click on refresh data. This DATA REFRESH will need to only pull the data from SQL where debtor_name = [selected value in combo box]
I asked about for issue #2 because I did not know I had an issue with my combo box (issue #1); however, I can handle that somehow; only need help with issue #2 now.
You can use SQL to populate the ComboBox with unique values.
Option Explicit
Sub Populate_Combobox_Worksheet()
Dim con As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set con = GetConnection
' query
SQL = " SELECT DISTINCT [Debtor_name] FROM [DATA$]" & _
" WHERE [Debtor_name] IS NOT NULL" & _
" ORDER BY [Debtor_Name]"
Set rs = con.Execute(SQL)
With Sheet2.ComboBox1
.Clear
.List = Application.Transpose(rs.GetRows)
.ListIndex = -1
End With
con.Close
End Sub
Sub RefreshData()
Dim con As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set con = GetConnection
' query
SQL = " SELECT * FROM [DATA$]" & _
" WHERE [Debtor_name] = '" & Sheet2.ComboBox1.Value & "'"
Set rs = con.Execute(SQL)
Sheet2.Range("A1").CopyFromRecordset rs
con.Close
End Sub
Function GetConnection() As ADODB.Connection
Dim wb As Workbook, sCon As String
Set wb = ThisWorkbook
sCon = "Data Source=" & wb.FullName & "; " & _
"Extended Properties=""Excel 12.0;HDR=Yes;"";"
' connect
Set GetConnection = New ADODB.Connection
With GetConnection
.Provider = "Microsoft.ACE.OLEDB.12.0;"
.ConnectionString = sCon
.Open
End With
End Function
Good day to all.
For the past 8hrs, I am looking for a pivot alternative in Access 2007 since the reference dll is not available in our Citrix account (OWC10.dll). So I did all the effort I could do to research workaround on this but I have nothing so far, so I think its time for a little help.
What I have here is a sample of the raw data..
This is the end result I am looking for, a pivot table, in which of course, can be viewed in a form (best solution) or to an extracted excel file.
So basically, I need to display:
how much time they worked each day
how many they worked each day.
I tried the TRANSFORM Statement/Crosstab and I get the error that there is too much rows to make it a column since I do have 20,000+ rows - 30days/month * people who worked. - DISTINCT them, but I dont know how?
I don't have the .dll file in our system, so normal pivoting is out of question. Does anyone know any alternatives that can give me these display results?
What you'll need to do is compile a query of the data you require, and push this into excel, then programmatically build a pivot table in excel, from access.
I use ADO for pretty much everything - so the syntax I've got here reflects this; If you DAO, you'll need to translate it.
sql = _
"SELECT Name, ProcessDate, HandlingTime " & _
"FROM tbl ... WHERE ..."
GenerateSimplePivot(excel_path&file_name_to_create, sql, 2)
Private Sub GenerateSimplePivot(xname As String, auditData As String, _ pivotColumns As Long)
Dim ii As Long
Dim XL As Object
Dim WB As Object
Dim WS1 As Object
Dim WS2 As Object
Dim rst As ADODB.Recordset
'create/assign xl objects
Set XL = CreateObject("Excel.Application")
XL.Visible = False
XL.DisplayAlerts = False
Set WB = XL.Workbooks.Add
Set WS1 = WB.Worksheets(1)
Set rst = New ADODB.Recordset
rst.Open auditData, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
For ii = 0 To rst.Fields.Count - 1
WS1.Cells(1, ii + 1) = rst.Fields(ii).Name
Next
WS1.Range("A2").CopyFromRecordset rst
WS1.Columns.Autofit
WS1.Name = "AuditData"
For ii = 0 To rst.Fields.Count - 1
'add column formatting logic here, if required
Next
rst.Close
If WB.Worksheets.Count < 2 Then
Set WS2 = WB.Worksheets.Add(, WB.Worksheets(WB.Worksheets.Count))
Else
Set WS2 = WB.Worksheets(2)
End If
WS2.Name = "PivotTable"
DoCmd.SetWarnings False
Dim PTcache As Object
Dim pt As Object
WS1.Activate
Set PTcache = WB.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=WS1.Range("A1").CurrentRegion.Address)
Set pt = PTcache.CreatePivotTable(TableDestination:=WS2.Range("a6"), TableName:="PivotTable ")
WS2.Activate
With pt
For ii = (pivotColumns - 3) To 2 Step -1
.PivotFields(ii).Orientation = xlPageField
Next
On Error Resume Next
.PivotFields(1).Orientation = xlPageField
Err.Clear
ON Error GoTo [error handler label]
.PivotFields(pivotColumns - 2).Orientation = xlRowField
.PivotFields(pivotColumns - 1).Orientation = xlColumnField
.PivotFields(pivotColumns).Orientation = xlDataField
End With
WB.SaveAs FileName:=xname
WB.Close
Set WS1 = Nothing
Set WS2 = Nothing
Set PTcache = Nothing
Set pt = Nothing
Set WB = Nothing
XL.Quit
DoCmd.SetWarnings True
Set rst = Nothing
Set WS1 = Nothing
Set WS2 = Nothing
Set PTcache = Nothing
Set pt = Nothing
Set WB = Nothing
Set XL = Nothing
End Sub
Is this what you were after?
For others who are having the same trouble as I am. I made a solution using CrossTab.
Using the Query Wizard is very easy and understandable. Below is the edited SQL query to suit my needs:
TRANSFORM format(Sum(MyCopy.[Duration]), "hh:mm:ss") AS SumOfDuration
SELECT MyCopy.[UserID].[FullName], MyCopy.[TL], Sum(MyCopy.[Duration]) AS [Total Of Duration]
FROM MyCopy
Group BY MyCopy.[UserID], MyCopy.[FullName], MyCopy.[TL]
PIVOT MyCopy.[Process Date];
Note: For report purposes, its very easy to just extract this query. I did use format so that it won't look ugly with the decimals. Apparently, MS Access does not give the answers real numbers, but same percentage. It solves differently when sum of total duration passes 24hrs. So I left it on decimal format for correct numbers to appear.
I have a PowerPoint presentation with ~200 slides. Each slide has one chart, with data that is updated monthly by a link to a master xlsx file.
To not show empty values (future months) in the charts, I open the data editor (chart right click > Edit data...) of every chart and select the range until the current month.
I wrote a macro for it in PowerPoint:
Sub Refresh_slides()
For i = 1 To ActivePresentation.Slides.Count
Set ObjSlide = ActivePresentation.Slides(i)
On Error Resume Next
Set mychart = ObjSlide.Shapes("Chart 3").Chart
mychart.Select
mychart.ChartData.Activate
Set wb = mychart.ChartData.Workbook
Set ws = wb.Worksheets(1)
Application.Run "Refresh_slides_AUX.xlsm!atual_slide"
wb.Close True
Next
End Sub
Refresh_slides_AUX.xlsm is an auxiliary macro worksheet to select the correct range of each chart (because PowerPoint VBA, as far as I know, don't have an option to do it):
Sub atual_slide()
Windows("Gráfico no Microsoft PowerPoint").Activate
ActiveSheet.ListObjects("Table1").Resize Range("$A$1:$I$23")
ActiveWindow.Close SaveChanges:=True
End Sub
The result is:
BEFORE:
AFTER:
It works, but after the range is resized the charts don’t change, they still looking like the BEFORE picture.
I know the process is right because if I do the resizing manually (right corner of the dotted line) the chart is updated correctly.
Add wb.Application.Update before wb.Close
See if that helps.
This is an old question but I had trouble finding an answer and this question came up as the first hit for my search.
I'd like to post a powerpoint vba routine that has an ActivateChartDataWindow method that I found was necessary to refresh the chart after I had updated the data.
Private Sub RefreshChart(slideName As String, shapeName As String, spName As String, dataRange As String)
'Add reference to Microsoft ActiveX Data Object 6.x Library
'Read data point info from SQL
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim connStr As String
Dim query As String
Dim sld As Slide
Dim shp As Shape
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Set sld = ActivePresentation.Slides(slideName)
Set shp = sld.Shapes(shapeName)
Set xlWB = shp.Chart.ChartData.Workbook
Set xlWS = xlWB.Sheets(1)
xlWS.Range(dataRange).Clear
Set conn = New ADODB.Connection 'CreateObject("adodb.connection")
connStr = "Provider=SQLOLEDB;Data Source='" & SQLServer & "';Initial Catalog=WVCore;Integrated Security=SSPI;"
conn.Open connStr
Set rs = New ADODB.Recordset 'CreateObject("adodb.recordset")
query = "exec " & spName 'usp_WVCRevenue
With rs
.ActiveConnection = conn
.Open query
xlWS.Range("A2").CopyFromRecordset rs 'Leave headings in tact
.Close
End With
shp.Chart.ChartData.ActivateChartDataWindow
xlWB.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub
I'm new in creating pivot tables in VBA. I'm curious to why my closed connections don't seem to affect existing connections? Also, I'm not able to refresh the table, I assume it is because VBA closes all connections when the procedure hits the end sub statement.
How can I make my pivot table refreshable and why do the connections always apprear in the existing connections even though they should be closed?
My code
Private Sub PivotAccessADODB()
' Link Pivottable to access database
Const ConnectionPath As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\name\Desktop\DataBase.accdb;Persist Security Info=False;"
Dim DataConnection As ADODB.Connection: Set DataConnection = New ADODB.Connection
Dim RecordSet As ADODB.RecordSet: Set RecordSet = New ADODB.RecordSet
DataConnection.ConnectionString = ConnectionPath
DataConnection.Open
Dim SQLString As String: SQLString = "SELECT * FROM ALFA"
With RecordSet
.ActiveConnection = DataConnection
.Source = SQLString
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
' Initiate accept of external data
Dim PTCache As PivotCache
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set PTCache.RecordSet = RecordSet
Dim PT As PivotTable: Set PT = PTCache.CreatePivotTable(Worksheets("Pivot").Range("A1"), "Test")
'Cleanup
RecordSet.Close: Set RecordSet = Nothing
DataConnection.Close: Set DataConnection = Nothing
The connection doesn't close because it is referenced, indirectly, by the pivot table. Using an idiom like the one below avoids this problem:
Private Function executeQuery(sqlStatement) As ADODB.recordSet
'where conn is a global ADODB.Connection object
Set executeQuery = conn.Execute(sqlStatement, RecordsAffected:=0)
End Function
Private Sub displayResultsFor(rs As recordSet, target As Range)
writeHeader rs, target
writeBody rs, target
End Sub
Private Sub writeHeader(rs As ADODB.recordSet, target As Range)
Dim header As Range
Dim i As Integer
Set header = target
For i = 0 To rs.Fields.Count - 1
header.value = rs.Fields(i).name
Set header = header.Offset(ColumnOffset:=1)
Next i
End Sub
Private Sub writeBody(rs As ADODB.recordSet, target)
target.Offset(RowOffset:=1).CopyFromRecordset rs
End Sub
This will display the contents of the recordset and avoid the pivottable and thereby avoid the stored connection. This may or may not be what you want. The other option that you have is write a bit of code to delete the connection. The downside of that is that you will no longer be able to use
pt.RefreshTable
I've spent the last few hours scouring the net for a way to do this without finding a way.
Basically, I have 3 fairly small tables in access that I wish to transfer to an excel workbook on a single worksheet.
I am currently only able to insert these tables onto separate worksheets using the following coding:
DoCmd.TransferSpreadsheet transfertype:=acExport, _
spreadsheettype:=acSpreadsheetTypeExcel12, _
TableName:=DTable, FileName:=strWorksheetPathTable, _
hasfieldnames:=True, _
Range:="Data"
I wish to transfer 2 more tables onto the "Data" worksheet, 1 starting at D1 (table is a single column) and the other at G1.
If anyone could help me out with a push that'd be sweet.
Cheers, Dane I
add microsoft.activex data objects 2.8 to your references
add microsoft office object library to your references
Then create your spreadsheet like this:
dim xl as object: set xl = createobject("Excel.Application")
XL.Visible = False
XL.DisplayAlerts = False
dim wb as object: set wb = xl.Workbooks.Add
dim ws as object: set ws = wb.Worksheets(1)
dim rst as new adodb.recordset
dim r as long, c as long 'row and column
r = 1
c = 1
rst.open "SELECT * FROM Table1", currentproject.connection, adOpenKeyset, adLockReadOnly
if not rst.eof then
ws.range(WS.Cells(r, c).Address).CopyFromRecordSet rst
end if
rst.close
rst.open "SELECT Count(*) FROM Table1", currentproject.connection etc
r = r + rst.fields(1) + 2
rst.Close
rst.open "SELECT * FROM Table2", etc
and so on.
wb.SaveAs FileName:=xlname
xl.Quit
set ws = nothing
set wb = nothing
set xl = nothing
This gives you what you want, with a line or two between each table. You can also now add code into the process to format your spreadsheet how you want if you wish to as well.
If a table needs column headings get them like this:
rst.open "SELECT * FROM Table1", currentproject.connection, adOpenKeyset, adLockReadOnly
dim ii as long
for ii = 0 to rst.fields.count - 1
ws.cells(r, ii + 1) = rst.fields(ii) 'you can offset using c if you want
next
if not rst.eof then
ws.range(WS.Cells(r, c).Address).CopyFromRecordSet rst
end if