Excel VBA: PivotTable CubeField Fact Table Name? - vba

I'm working with a large OLAP Cube, and I'm building very rudimentary search functionality to help me parse through the amount of data (~30 fact tables, 30 dimensions, plus calculated measures), but I've come across an interesting issue. When I access a CubeField.Name property for a fact table member or a calculated measure, it comes through as [Measures].[FieldName] instead of pointing me to the correct Fact table / calculated measure folder.
Here's the code I'm using:
Sub X()
Dim pvtTable As PivotTable
Dim oCubeField As CubeField
Set pvtTable = ActiveSheet.PivotTables(1)
For Each oCubeField In pvtTable.CubeFields
If InStr(LCase(oCubeField.Name), "spread") > 0 Then
Debug.Print oCubeField.Parent & ": " & oCubeField.Name
End If
Next
End Sub
Any ideas on how I can actually reach the fact table name? Or the calculated measure's folder structure? Thanks!

Try oCubeField.Value perhaps. The reference for the CubeField object says:
Name Returns a String value that represents the name of the object.
Value Returns a String value that represents the name of the specified field.

Unfortunately, you can't do that, because a measure expression may link to a few fact tables.
But you can query and analyse cube metadata with OpenSchema() function.
Something like this:
Sub GetMeasuresList()
Const adSchemaMeasures = 36
Set ADOCon = ActiveCell.PivotTable.PivotCache.ADOConnection
Set RecSet = ADOCon.OpenSchema(adSchemaMeasures)
While Not RecSet.EOF
Debug.Print RecSet!MEASURE_NAME & ": " & RecSet!EXPRESSION
RecSet.MoveNext
Wend
End Sub
OLE DB for OLAP Schema Rowsets
How To Use the ADO OpenSchema Method in Visual Basic

Related

Looping through a table in SAP returns an error

I am running a script from Excel and would like to loop through rows in a table in order to obtain values for each line in a table. Here is what I basically need to do:
1.Go to a page with a table in SAP
Double click on a line, which brings me to a window with values that I need to copy and insert in a spreadsheet.
Loop through an entire table in the same fashion and repeat a procedure in SAP.
The attached pictures show tables I am working with. I am not sure which of them are real tables that can be declared as Objects. I tried to run a code but it returns an error "The object does not support this property or method"(RowCount)
first type of object
second type of object
third type of object
Dim Table As Object
Dim rows As Long
Dim i As Long
Set Table = Session.FindById("wnd[0]/usr/cntlUSAGE_TREE_CONTAINER/shellcont/shell/shellcont[1]/shell[1]")
rows = Table.RowCount - 1
For i = 0 To rows
Session.FindById("wnd[0]/usr/cntlUSAGE_TREE_CONTAINER/shellcont/shell/shellcont[1]/shell").selectedNode = " i"
Session.FindById("wnd[0]/usr/cntlUSAGE_TREE_CONTAINER/shellcont/shell/shellcont[1]/shell").doubleClickNode " i"
Next i
In my opinion, the attached pictures contain the following contents:
Tree
Table
Grid
The program example refers to a tree.One of the possible solutions might look like this:
Set myTree = Session.FindById("wnd[0]/usr/cntlUSAGE_TREE_CONTAINER/shellcont/shell/shellcont[1]/shell[1]")
rowCount = myTree.GetColumnCol(myTree.GetColumnNames.item(0)).length
rows = rowCount - 1
For i = 0 To rows
myTree.selectedNode right(" " + CStr(i),11)
myTree.doubleClickNode right(" " + CStr(i),11)
Next i
Regards,
ScriptMan

Can I get data from power query to a vba variable?

I have a power query function, e.g. getData with one parameter filename
Can I invoke that function directly in a vba variable? Something like:
Sub MyTest()
Dim MyVar
MyVar = ThisWorkbook.Queries("getData").Invoke("mytable.xls")
MsgBox "The Value is " & MyVar
End Sub
I use Excel 2016
Unfortunately, you cannot load the Power Query result to a VBA variable. You have to first load it to the sheet.
Here is a thread, where a Microsoft employee confirms that:
Link to Microsoft Employee relating to that issue
Contrary to the link in the accepted answer, it is possible to get an array from a query if you load the query to the data model. It can be a pain, and there are lots of pitfalls (spaces in table names, and I haven't tested where the query output is a list or otherwise not a table).
These functions aren't cleaned up, but they have given me success, and show where to poke around.
Function GetModelADOConnection()
'We just need the ADOConnection; the rest is for perusal
Set wbConnections = ThisWorkbook.Connections
Set Model = ThisWorkbook.Model
Set ModelDMC = Model.DataModelConnection
Set ModelDMCMC = ModelDMC.ModelConnection
Set GetModelADOConnection = ModelDMCMC.ADOConnection
End Function
Sub ListConnectionTables()
'Run this to dump a list of available tables in the immediate window, so you can see what you'll need to query
'https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/schemaenum
Set conn = GetModelADOConnection
Set TablesSchema = conn.OpenSchema(20)
Debug.Print "TABLE_SCHEMA", "TABLE_NAME", "COLUMN_NAME" 'headers for immediate window
Do While Not TablesSchema.EOF
Set ColumnsSchema = conn.OpenSchema(4, Array(Empty, Empty, "" & TablesSchema!TABLE_NAME))
Do While Not ColumnsSchema.EOF
If TablesSchema!TABLE_SCHEMA <> "$SYSTEM" Then
Debug.Print TablesSchema!TABLE_SCHEMA, TablesSchema!TABLE_NAME, ColumnsSchema!COLUMN_NAME
End If
ColumnsSchema.MoveNext
Loop
TablesSchema.MoveNext
Loop
End Sub
Function GetRecordSetFromConnection(TABLE_NAME)
'Requires that connection is added to data model.
'Watch out for table names with spaces in them - would need additional handling
'Use the ListConnectionTables function provided above to try to sniff out what to use for the TABLE_NAME, and additional trial and error may be needed
Set conn = GetModelADOConnection
Set rs = CreateObject("ADODB.RecordSet")
rs.Open "SELECT * From $" & TABLE_NAME & ".$" & TABLE_NAME, conn
Set GetRecordSetFromConnection = rs
End Function
If you succeed in getting your query into a recordset, then hopefully you know where to go from there. The simplest way to turn that into an array is with myRecordSet.GetRows(). That gives a transposed version of the table, but for help from there it will just require some Googling.

vba store recordset as integer variable

First time poster, I finally had a question that I couldn't find an answer to here.
I have an MS Access query that returns 1 result (which is a number) that I want to store as an integer variable (x) so I can use it later for a loop. The issue is that because I'm using it as a recordset and the variable is an integer, I'm receiving a "Type Mismatch" error.
Right now I'm just storing the result to a cell and setting the variable equal to the cell:
Ws.Range("A1") = Db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").GetRows(1)
x = Ws.Range("A1")
Ws.Range("A1").Delete
And then later I just have a loop that runs x times:
For i = 0 To x
Basically, I just want to have some code that looks like this:
x = Db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").GetRows(1)
Any help here would be huge. Thank you!
The following should give you the correct result:
Dim x As Integer
Dim db As DAO.Recordset
db.MoveFirst
If IsNumeric(db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").Fields(0).Value) Then
x = CInt(db.OpenRecordset("SELECT COUNT(Asset_Name) FROM Assets WHERE Active = True").Fields(0).Value)
Else
MsgBox "The query did not return a number." & Chr(10) & "Aborting..."
End If
Note, that you are using DAO and not ADO as your original tags on the post indicated. Still, they both behave rather similar and the cursor is normally on the first row (when the data is returned). So, MoveFirst should not be necessary. Still, Microsoft themselves keep using it in its own sample code all the time. The first column if for DAO and ADO alike .Fields(0).

Populating reports with calculated values

I hope this is a simple question and you don't have to waste too much of you time on it.
I have an report (called repRAD78) which contains a textbox (called txtRAD8). I would like to populate txtRAD8 with a calculated value based on numbers pulled from a query called qryrRAD78.
Looking through the forums it looks like recordsets would be the solution but this is my first foray into recordsets and it's not going well. :(
The code I have pasted in below I have pulled together from a number of places and it doesn't produce any errors but puts the same value into txtRAD8 for all the records.
I'm sorry if this is a stupid question but it's been driving me potty.
Many thanks for your time.
Al.
Public Sub Calc()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qryrRAD78")
rst.MoveFirst
Do Until rst.EOF = True
Dim lngMean As Long
Dim lngRAD78max As Long
Dim lngRAD78_1 As Long
Dim lngRAD78_2 As Long
Dim lngRAD78_3 As Long
Dim lngRAD7 As Long
Dim lngRAD8 As Long
lngRAD78_1 = rst![RAD78_1]
lngRAD78_2 = rst![RAD78_2]
lngRAD78_3 = rst![RAD78_3]
lngRAD8b_c = rst![RAD8b_c]
lngMean = (lngRAD78_1 + lngRAD78_2 + lngRAD78_3) / 3
lngRAD78max = Maximum(Abs(lngRAD78_1), Abs(lngRAD78_2), Abs(lngRAD78_3))
lngRAD7 = ((lngRAD78max - lngMean) / lngMean) * 100
lngRAD8 = ((lngMean - lngRAD8b_c) / lngRAD8b_c) * 100
txtRAD8.Value = lngRAD8
rst.MoveNext
Loop
rst.Close
dbs.Close
End Sub
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Calc
End Sub
Here's a second approach to this. Rather than using a function in the code, take the calculations from your Calc() routine and put them in another query.
SELECT idrRAD78,
(RAD78_1 + RAD78_2 + RAD78_3) AS Mean,
(IIf(Abs(RAD78_1) > Abs(RAD78_2),
IIf(Abs(RAD78_1) > Abs(RAD78_3), RAD78_1, RAD78_3),
IIf(Abs(RAD78_2) > Abs(RAD78_3), RAD78_2, RAD78_3))) AS RAD78Max,
(((RAD78max - Mean) / Mean) * 100) AS RAD7,
(((Mean - RAD8b_c) / RAD8b_c) * 100) AS RAD8
FROM qryrRAD78
This will give you a query that performs the same calculations as your existing function. Then just edit the report query to join to this new query (just like joining a table) using something like:
FROM ReportQuery INNER JOIN NewQuery ON ReportQuery.idrRAD78 = NewQuery.idrRAD78
Change the query names to match the real names. Add the fields from the new query in the SELECT part of your report query:
SELECT <existing field list>, RAD7, RAD8
Then set txtRAD8 to the RAD8 field.
I'm just doing this from memory as I'm not in front of my own computer, but hopefully that makes sense and is close enough to the correct code.
The problem with this function is that every row on the report is going to have a textbox called txtRAD8. So what you are really doing is updating every textbox on the report with the same value (once for every loop through the recordset). You are not actually setting the value for each individual row.
What you need to do is make the value of the textbox = Calc(RowID). Then your query uses the passed-in parameter to get the value for that one record instead of looping through the whole recordset, and updates just that one row on the report.
So your Sub becomes a Function, and returns the calculated value.

VBA PivotItems Index Variable

I am trying to loop through different years of data from a OLAP pivot table and for each year I have to drilldown to get the data I am looking for. Here is what the macro recorder gave me for 2013:
'This is the cell that has to be drilled down
Range("A2").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("[Date].[YMD].[Year Name]") _
.PivotItems("[Date].[YMD].[Year Name].&[***2013***]").DrilledDown = True
End With
[Date].[YMD] is the field name and [Year Name] is the source name.
However I am trying to replace the &[2013] with a variable "Yr" which will allow me to select and then drill down into each year.
But I get the following message: "Unable to get the PivotItems property of the PivotField class"
Is there a specific syntax for PivotItems Index? Are there limitations to using a variable to reference from an OLAP Pivot Table? I have tried defining Yr as a Double and also as a Variable but it didn't help..
Thanks for any advice!!
Try this
Dim YR As Integer
YR = 2013
With ActiveSheet.PivotTables("PivotTable1").PivotFields("[Date].[YMD].[Year Name]") _
.PivotItems("[Date].[YMD].[Year Name].&[" & YR & "]").DrilledDown = True
End With