I'm trying to control a Pivot table's filter by using VBA and I'm struggling to correctly using the "VisibleItemsList" with a variable that contains the filters settings, I'll post the code for a better understandig:
Public Sub updatePivotTable(param2Set() As Variant)
'Array("[Budget].[AM].&[Aeffe USA]","[Budget].[AM].&[Alberganti]","[Budget].[AM].&[Blokh]","[Budget].[AM].&[Bondi]")
Dim y As Integer
Dim parametersCount As Integer
parametersCount = UBound(param2Set)
Dim filters As String
'filters = "Array("
For y = 0 To parametersCount - 1
filters = filters + """[Budget].[AM].&[" & param2Set(y) & "]"", "
Next y
filters = filters + """[Budget].[AM].&[" & param2Set(y) & "]"""
With Sheets("Export BUDG")
.PivotTables("pvtToExport").PivotFields("[Budget].[AM].[AM]").VisibleItemsList = Array(filters)
End With
End Sub
The error I get is:
Query (1, 28) Sintax ',' incorrect. ("[Budget].[AM].&[Caprioli]",
"[Budget].[AM].&[Bondi]")."
Can anyone point me in the right direction? Thanks.
Related
I have a form in which there is a combobox that holds all the badge numbers (example of a badge # : 12345) but when I try to assign it to a variable in vba it gives me the following error:
run-time error '6'
overflow
But when I go to debug it shows that Combo529.Value = 12345 but it wont assign it to my variable and gives the error
Private Sub reportRecord_Click()
Dim badgeNum As Integer
badgeNum = Combo529.Value
reportRecord.Value = getReport(badgeNum)
End Sub
and here is the code for the getReport() function:
Function getReport(badge As Integer)
Dim yearNow As Integer
yearNow = year(Date)
Dim report As String
report = badge & "-" & yearNow & "-"
Dim i As Integer
For i = 1 To 3
If Not IsNull(DLookup("Badge_ID", "Employee_Self_Assessment", "Report_ID = ' " & report & "0" & i & "'")) Then
getReport = 0
Else
Next i
getReport = 1
End If
End Function
Presume Badge_ID is an autonumber or long integer field and apparently the value is too large for Integer variable. Declare the variable as Long. Or a Variant type should work - variables not explicitly declared will default to Variant.
I would like to convert a range of numbers (and single digits) from a number-only format to alpha-numeric format. Entire statement is in a single, excel cell and would like the converted version to be in a neighboring cell.
As an example:
Assuming 1-24=B1-B24
Assuming 25-48=C1-C24
INPUT—
screen 1-3,5,7-9,11-30,32-37,39-40,41,44-46
DESIRED OUTPUT (all acceptable)
screen B1-B3,B5,B7-B9,B11-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24,C1-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24
screen C1-C6,C8-C13,C15-C16,C17,C20-C22
Using excel functions is proving quite cumbersome so excel macro would be better. I've looked for examples of requested conversion but haven't found anything.
Any help is greatly appreciated.
Cheers,
Bob
Hey here is a solution that i tested out. Not sure if "screen" needs to be in the string or not. Let me know and I will tweak it if that's the case.
Its a user defined function. So drop this vba in a module and then go to a worksheet and type in "=AlphaConvert(" + the cell reference.
Assumption here is that only one cell will be referenced at a time.
Last this could easily be converted to a sub routine and probably run a bit faster than the function.
Public Function AlphaConvert(TargetCell As Range)
Dim v As Long
Dim vArr() As String
Dim i As Long
Dim iArr() As String
Dim a As String
vArr = Split(TargetCell.Value, ",")
For v = LBound(vArr) To UBound(vArr)
If InStr(vArr(v), "-") > 0 Then
iArr = Split(vArr(v), "-")
For i = LBound(iArr) To UBound(iArr)
If i = LBound(iArr) Then
a = AlphaCode(iArr(i))
Else
a = a & "-" & AlphaCode(iArr(i))
End If
Next i
vArr(v) = a
Else
vArr(v) = AlphaCode(vArr(v))
End If
If v = LBound(vArr) Then
AlphaConvert = vArr(v)
Else
AlphaConvert = AlphaConvert & "," & vArr(v)
End If
Next v
End Function
Private Function AlphaCode(Nbr As Variant)
Select Case Nbr
Case 1 To 24
AlphaCode = "B" & Nbr
Case Else
AlphaCode = "C" & Nbr - 24
End Select
End Function
I am working on a script which selects only the needed slicer items. I tried using .SlicerItems.Selected = True / False for selecting and deselecting but I am using an OLAP data source in which case .Selected is read-only. The slicer items are in the format of YYYYWW so 7th week of 2018 would be 201807.
I recorded a macro selecting some slicer items and this is what it gave me:
Sub Macro2()
ActiveWorkbook.SlicerCaches("Slicer_YYYYWW").VisibleSlicerItemsList = Array( _
"[Results].[YYYYWW].&[201726]", "[Results].[YYYYWW].&[201727]", _
"[Results].[YYYYWW].&[201728]", "[Results].[YYYYWW].&[201729]", _
"[Results].[YYYYWW].&[201730]", "[Results].[YYYYWW].&[201731]", _
"[Results].[YYYYWW].&[201732]", "[Results].[YYYYWW].&[201733]", _
"[Results].[YYYYWW].&[201734]", "[Results].[YYYYWW].&[201735]", _
"[Results].[YYYYWW].&[201736]", "[Results].[YYYYWW].&[201737]", _
"[Results].[YYYYWW].&[201738]", "[Results].[YYYYWW].&[201739]", _
"[Results].[YYYYWW].&[201740]", "[Results].[YYYYWW].&[201741]", _
"[Results].[YYYYWW].&[201742]", "[Results].[YYYYWW].&[201743]", _
"[Results].[YYYYWW].&[201744]", "[Results].[YYYYWW].&[201745]", _
"[Results].[YYYYWW].&[201746]", "[Results].[YYYYWW].&[201747]", _
"[Results].[YYYYWW].&[201748]", "[Results].[YYYYWW].&[201749]", _
"[Results].[YYYYWW].&[201750]", "[Results].[YYYYWW].&[201751]", _
"[Results].[YYYYWW].&[201801]", "[Results].[YYYYWW].&[201802]", _
"[Results].[YYYYWW].&[201803]")
End Sub
So I tried following this template and create an array like that. This is how far I have gotten:
Sub arrayTest()
Dim startDate As Long
Dim endDate As Long
Dim n As Long
Dim i As Long
Dim strN As String
Dim sl As SlicerItem
Dim strArr As Variant
Dim dur As Long
Dim result As String
endDate = Range("C17").Value ' endDate is the last SlicerItem to be selected
startDate = Range("G17").Value ' startDate is the first SlicerItem to be selected
dur = Range("C19").Value ' duration is the the number of SlicerItems to be selected
i = 0
ReDim strArr(dur) As Variant
With ActiveWorkbook.SlicerCaches("Slicer_YYYYWW")
' .ClearManualFilter
For n = startDate To endDate
strN = CStr(n) ' convert n to string
If n = 201753 Then ' this is needed for when the year changes
strN = CStr(201801)
n = 201801
End If
strArr(i) = """[Results].[YYYYWW].&[" & strN & "]""" ' write string into array
i = i + 1
' For Each sl In .SlicerCacheLevels(1).SlicerItems
' If sl.Name = strN Then
' sl.Selected = True
' Else
' sl.Selected = False ' this is read-only for OLAP data so it's not working
' End If
' Next
Next
MsgBox Join(strArr, ", ") ' the MsgBox returns the correct string to be applied to select the right slicer items
.VisibleSlicerItemsList = Join(strArr, ", ") ' Error 13: Type mismatch
End With
End Sub
Currently, the code gives Error 13: Type mismatch on .VisibleSlicerItemsList = Join(strArr, ", "), which is also commented. So I'm guessing that either dimensioning strArr as Variant is wrong, the data is not inserted correctly into strArr or it's just impossible to do it this way. In the case of the latest one, how should I do it?
The part commented out on lines 29-35 does not work as it gives the usual error of Application-defined or object-defined error (1004) on sl.Selected = False.
I had a similar issue to overcome. Which I resolved using the following code:
Sub show_SlicerItems()
Dim sc As SlicerCache
Dim sL As SlicerCacheLevel
Dim si As SlicerItem
Dim slicerItems_Array()
Dim i As Long
Application.ScreenUpdating = False
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Name")
Set sL = sc.SlicerCacheLevels(1)
ActiveWorkbook.SlicerCaches("Slicer_Name").ClearManualFilter
i = 0
For Each si In sL.SlicerItems
ReDim Preserve slicerItems_Array(i)
If si.Value <> 0 Then
slicerItems_Array(i) = si.Name
i = i + 1
End If
Next
sc.VisibleSlicerItemsList = Array(slicerItems_Array)
Application.ScreenUpdating = True
End Sub
You need to feed .VisibleSlicerItemsList an array, not a string. Ditch the Join.
And your strArr assignment should be like this: strArr(i) = "[Results].[YYYYWW].&[" & strN & "]" i.e. you don't need to pad it out with extra "
Edit: Out of interest, I happen to be building a commercial add-in that is effectively a Pop-up Slicer, that allows you to filter an OLAP PivotTable to show all items between a range like you are attempting to do. It also lets you filter on wildcards, crazy combinations of AND and OR, and filter on lists stored in external ranges.
Here's a screenshot of it in action. Note there is a search bar up the top that lets you use < or > together to set lower and upper limits, which is what I've done in the current Search. And you can see the result: it has correctly identified the 14 items from the PivotField that fit the bill.
All I need to do to filter the PivotTable on these is click the "Filter on selected items" option, and it does just that:
But working out how to do this - particularly given the limitations of the PivotTable object model (especially where OLAP PivotTables are concerned) was a VERY long term project, with many, many hurdles to overcome to make it work seamlessly. I can't share the code I'm afraid, as this is a commercial offering that I aim to release shortly. But I just wanted to highlight that while this is certainly possible, you are going to be biting off quite a bit if you want it to not throw errors when items don't exist.
Forget my other answer...you can use the Labels Filter to do this easily, provided the field of interest is in the PivotTable as either a Rows or Columns field. Fire up the Macro Recorder, and do the following:
...and you'll see that the PivotTable gets filtered:
...and the resulting code is pretty simple:
ActiveSheet.PivotTables("PivotTable1").PivotFields("[Table1].[YYYYWW].[YYYYWW]" _
).PivotFilters.Add2 Type:=xlCaptionIsBetween, Value1:="201726", Value2:= _
"201803"
Use this:
Sub seleciona_lojas()
Dim strArr()
Dim x As Long
Dim i As Long
For x = 2 To 262
ReDim Preserve strArr(i)
strArr(i) = "[Lojas].[Location_Cd].&[" & Planilha5.Range("B" & x).Value & "]"
i = i + 1
Next x
ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Location_Cd1").VisibleSlicerItemsList = strArr
End Sub
I am working on a code that should calculate simple foundations, and in order to do that I have to return 2 values with my function -preferably in two different columns.
Function FundacaoSimples(b, l, carga) As Variant
tensao = Sheets("Tabelas e Constantes").Range("tensao").Value
Dim area As Double
Dim Bs As Single
Dim Ls As Single
Dim Resultado(1 To 2) As String
If b = l Then
area = (1.1 * carga) / tensao
Bs = Sqr(area)
Ls = Bs
ElseIf b <> l Then
area = (1.1 * carga) / tensao
Bs = Sqr((2 * area) / 3)
Ls = (3 * Bs) / 2
End If
Resultado(1) = Round(Bs, 2)
Resultado(2) = Round(Ls, 2)
FundacaoSimples = (Resultado(1) & " / " & Resultado(2))
End Function
This rounding I am using it just to get a value rounded with 2 decimals, e.g: 2,73 to 2,75; 0,89 to 0,90.
I tried working with ActiveCells.Offset(0,1), but the statement isn't valid.
Is it possible to to just jump one column to the right?
You could use ActiveCell.Offset(0, 1).value = SomeValue, however - That's when writing a regular Sub. You're writing a Function / User Defined Function.
Within a UDF it is not possible to alter different cells.
However, a workaround is to have the UDF and when it's entered in a cell, you can then use the Worksheet_Change event to alter the cell next to the Target parameter of that event.
Edit:
Some sample code:
In a regular module:
Public Function MyUDF(param1 as integer, param2 as integer) as Integer
MyUDF = param1 + param2
End Function
In the Worksheet where you want the offset:
Private Sub Worksheet_Change(Byval Target as Range)
If Left(Target.Formula, 6) = "=MyUDF" Then
Target.Offset(0, 1).value = "somevalue at the offset cells"
End If
End Sub
In general, functions should not be writing values or accessing values from a spreadsheet. They should access their parameters and return result.
Try like this, an oversimplified version of what you need:
Option Explicit
Public Sub TestMe()
ActiveCell = FundacaoSimples(0)
ActiveCell.Offset(0, 1) = FundacaoSimples(1)
End Sub
Function FundacaoSimples() As Variant
ReDim varResult(1)
varResult(0) = 55
varResult(1) = 100
FundacaoSimples = varResult
End Function
Then you can edit the function a bit with your own parameters and use it further.
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.