I am trying to remove some fields from a Pivot Table. The Table changes but the list of items I am trying to remove stay the same.
It works if I just use the deselect code like this:
Set pf =ActiveSheet.PivotTables("PivotTable1").PivotFields("ServiceName")
pf.PivotItems("Disk").Visible = False
pf.PivotItems("SNMP").Visible = False
pf.PivotItems("POP").Visible = False..... and so on for about 140 Items
My problem comes when I have a Pivot table that does not contain the PivotItem. Run time error: "Unable to get the PivotItems property of the PivotField class
So I thought I would us a simple IF THEN:
If pf = ("POP") Then pf.PivotItems("POP").Visible = False
But it doesn't work. It doesn't do anything, no errors, no changes to the field. It just blinks and its done.
What am I missing?
You could iterate over the PivotItems, therefore you modify only existing items, like so (see MSDN for a description):
Dim dict As New Scripting.Dictionary
' add the items to be removed
' dictionaries take key and value, but we are
' only interested in the key here. So the
' value could really be anything.
c.Add "name1" 1
c.Add "name2" 1
Worksheets("sheet4").Activate
With Worksheets("sheet3").PivotTables(1)
For i = 1 To .PivotFields.Count
For j = 1 To .PivotFields(i).PivotItems.Count
If c.Exists(.PivotFields(i).PivotItems(j).Name) then
.PivotFields(i).PivotItems(j).Visible = False
End If
Next
Next
End With
Related
I'm trying to loop through all slicer items from three slicers and then call another sub within the inner most loop. The slicers are connected to an OLAP data source. For each slicer I'd only like it to loop through visible slicer items. I hide the items with no data after selecting an item from the outer slicer. If I use the following code, then it will loop through all slicer items, not just the visible ones:
'Begin Loop through Fund Name Slicer
i = 1
Do Until i = ActiveWorkbook.SlicerCaches(SC1).SlicerCacheLevels.Item.count + 1
'select ith item in Fund Name Slicer
ActiveWorkbook.SlicerCaches(SC1).VisibleSlicerItemsList = Array( _
ActiveWorkbook.SlicerCaches(SC1).SlicerCacheLevels.Item.SlicerItems(i).Name)
'hide items with no data in Scenario Name Slicer
With ActiveWorkbook.SlicerCaches(SC2).Slicers(S2)
.SlicerCacheLevel.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
.SlicerCacheLevel.SortItems = xlSlicerSortDataSourceOrder
End With
'Begin Loop through Scenario Name Slicer
j = 1
Do Until j = ActiveWorkbook.SlicerCaches(SC2).SlicerCacheLevels.Item.count + 1
'select jth item in Scenario Name Slicer
ActiveWorkbook.SlicerCaches(SC2).VisibleSlicerItemsList = Array( _
ActiveWorkbook.SlicerCaches(SC2).SlicerCacheLevels.Item.SlicerItems(j).Name)
'hide items with no data in Override Set Name Slicer
With ActiveWorkbook.SlicerCaches(SC3).Slicers(S3)
.SlicerCacheLevel.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
.SlicerCacheLevel.SortItems = xlSlicerSortDataSourceOrder
End With
'Begin Loop through Override Set Name Slicer
k = 1
Do Until k = ActiveWorkbook.SlicerCaches(SC3).SlicerCacheLevels.Item.count + 1
'Select kth item in Override Set Name Slicer
ActiveWorkbook.SlicerCaches(SC3).VisibleSlicerItemsList = Array( _
ActiveWorkbook.SlicerCaches(SC3).SlicerCacheLevels.Item.SlicerItems(k).Name)
'Call sub that copies and pastes summary values
Call SelectedComboOnly
k = k + 1
Loop
j = j + 1
Loop
i = i + 1
Loop
I tried to replace the Do Until statements with something like:
Do Until i = ActiveWorkbook.SlicerCaches(SC1).VisibleSlicerItems.count + 1
but this throws a run time error. I found here that "Attempting to access the VisibleSlicerItems property for slicers that are connected to an OLAP data source (SlicerCache.OLAP = True) generates a run-time error." Is there really no way to access the number of visible slicer items here? Or should I try something completely different? My macro does what it's supposed to do, but it takes about 25 minutes. I'm just trying to run through only visible slicer items to optimize the code. This would take the combinations that it has to run through from 1,458 to 84. I already have screen updating off.
Sorry, for the late answer, but I just want to share below solution that worked for me:
UBound(ThisWorkbook.SlicerCaches(SC1).SlicerCacheLevels(1).VisibleSlicerItemsList)
EDIT:
The .VisibleSlicerItemsList property returns an array so You can't use the .count property on It, like You would do on collections. In order to get the length of an array, use the function UBound (see here).
Try using this logic:
Sub Test()
Dim SC As SlicerCache
Dim SI As SlicerItem
For Each SC In ThisWorkbook.SlicerCaches 'this will loop through all your slicer caches in the whole workbook
'if you want to skip an slicer do it here and skip to the next
For Each SI In SC.VisibleSlicerItems 'this will loop through all your visible slicer items
'some code
Next SI
Next SC
End Sub
I am hoping to use the string value of a selected Listbox item in a .Match function within VBA - I need the the value '1' to be entered into the row where the value of the selection matches a value in column "A:A", on a specific column.
What I thought I would be able to do is to use a .value argument for the selected ListBox item, however this seems to either error out or give me a Boolean response, which isn't what I am after (I am after the actual string value of the item).
I have already looped through all items to set the Selected argument to True, and then I am looping through the list one by one to add '1' to the correct range.
Here is the code I thought would work (but doesn't, it throws an error of "Run-time error '13': Type mismatch" which is presumably down to the .Value not being a String.
For x = 0 To Me.CreditsEmployeesListBox.ListCount - 1
Me.CreditsEmployeesListBox.Selected(x) = True
Next
For i = 0 To Me.CreditsEmployeesListBox.ListCount - 1
If Me.CreditsEmployeesListBox.Selected(i) = True Then
employeeRow = WorksheetFunction.Match(Me.CreditsEmployeesListBox(i).Value, IndexSheet.Range("A:A"), 0)
IndexSheet.Range(Cells(employeeRow, showCodeColumn).Address).Value = 1
End If
Next
It errors out on the 'employeeRow = ...' line. Here, I am essentially trying to ask it:
employeeRow = WorksheetFunction.Match(<value of the currently referenced ListBox item>,IndexSheet.Range("A:A"),0)
Is this possible with VBA or am I going about this the wrong way?
Thanks
Matt
As an "hybrid" answer (as there is more than one problem) try this:
For x = 0 To Me.CreditsEmployeesListBox.ListCount - 1
Me.CreditsEmployeesListBox.Selected(x) = True
Next
Dim employeeRow As Variant
For i = 0 To Me.CreditsEmployeesListBox.ListCount - 1
If Me.CreditsEmployeesListBox.Selected(i) = True Then
employeeRow = Application.Match(Me.CreditsEmployeesListBox.List(i), IndexSheet.Columns(1), 0)
If IsNumeric(employeeRow) Then IndexSheet.Cells(employeeRow, showCodeColumn).Value = 1
End If
Next
This also should avoid VBA-errors.
If any questions are left, just ask :)
I have some problems with my excel VBA code, it does not work and yes, I do not know why...
I want to add each Record number once in a collection. My code looks like this:
For i = 1 To lo.ListRows.Count
Count = 1
Do While recordList.Count >= Count
recordFound = False
If lo.ListColumns("Record").DataBodyRange.Rows(i) = recordList(Count) Then
recordFound = True
End If
If recordFound = False Then
recordList.Add (lo.ListColumns("Record").DataBodyRange.Rows(i))
End If
Count = Count + 1
Loop
Next
What it does now, it returns empty collection...
Whould be great if you could help me guys!
There is no real need to test the Collection to see if the item exists if you give it a key.
You can code something like:
On Error Resume Next
For I = 1 To lo.ListRows.Count
With lo.ListColumns("Record").DataBodyRange.Rows(I)
RecordList.Add Item:=.Value, Key:=CStr(.Value)
End With
Next I
On Error GoTo 0
Adding an item with the same key will cause the operation to be rejected. If you are concerned about other errors than the duplicate key error, you can always check the error number in the inline code and branch depending on the results.
I haven't been able to test this with the reference to lo but it works with a reference to a range
Dim objDictionary As Object
Dim dictionaryKey As Variant
Dim i As Long
Set objDictionary = CreateObject("Scripting.Dictionary")
For i = 1 To lo.ListRows
objDictionary.Item(CStr(lo.ListColumns("Record").DataBodyRange.Rows(i))) = objDictionary.Item(CStr(lo.ListColumns("Record").DataBodyRange.Rows(i))) + 1
Next i
For Each dictionaryKey In objDictionary.keys
' Do something
Next dictionaryKey
I have used a dictionary object instead of a normal collection object as it should do what you are trying to do. Because the item is incremented each time, you can also return the count of each item by using
objDictionary.item(dictionaryKey)
Weird problem. Stepping through the code with inspections gives me correct answers. Just running it doesn't.
This program loops through each cell in a column, searching for a regex match. When it finds something, checks in a adjacent column to which group it belongs and keeps a count in a dictonary. Ex: Group3:7, Group5: 2, Group3:8
Just stepping through the code gives me incorrect results at the end, but adding and inspection for each known item in the dictionary does the trick. Using Debug.Print for each Dictionary(key) to check how many items I got in each loop also gives me a good output.
Correct // What really hapens after running the code
Group1:23 // Group1:23
Group3:21 // Group3:22
Group6:2 // Group6:2
Group7:3 // Group7:6
Group9:8 // Group9:8
Group11:1 // Group11:12
Group12:2 // Group12:21
Sub Proce()
Dim regEx As New VBScript_RegExp_55.RegExp
Dim matches
Dim Rango, RangoJulio, RangoAgosto As String
Dim DictContador As New Scripting.Dictionary
Dim j As Integer
Dim conteo As Integer
Dim Especialidad As String
regEx.Pattern = "cop|col"
regEx.Global = False 'True matches all occurances, False matches the first occurance
regEx.IgnoreCase = True
i = 3
conteo = 1
RangoJulio = "L3:L283"
RangoAgosto = "L3:L315"
Julio = Excel.ActiveWorkbook.Sheets("Julio")
Rango = RangoJulio
Julio.Activate
For Each celda In Julio.Range(Rango)
If regEx.Test(celda.Value) Then
Set matches = regEx.Execute(celda.Value)
For Each Match In matches
j = 13 'column M
Especialidad = Julio.Cells(i, j).Value
If (Not DictContador.Exists(Especialidad)) Then
Call DictContador.Add(Especialidad, conteo)
GoTo ContinueLoop
End If
conteo = DictContador(Especialidad)
conteo = CInt(conteo) + 1
DictContador(Especialidad) = conteo
Next
End If
ContinueLoop:
i = i + 1
'Debug.Print DictContador(key1)
'Debug.Print DictContador(key2)
'etc
Next
'Finally, write the results in another sheet.
End Sub
It's like VBA saying "I'm going to dupe you if I got a chance"
Thanks
Seems like your main loop can be reduced to this:
For Each celda In Julio.Range(Rango)
If regEx.Test(celda.Value) Then
Especialidad = celda.EntireRow.Cells(13).Value
'make sure the key exists: set initial count=0
If (Not DictContador.Exists(Especialidad)) Then _
DictContador.Add Especialidad, 0
'increment the count
DictContador(Especialidad) = DictContador(Especialidad) +1
End If
Next
You're getting different results stepping through the code because there's a bug/feature with dictionaries that if you inspect items using the watch or immediate window the items will be created if they don't already exist.
To see this put a break point at the first line under the variable declarations, press F5 to run to the break point, then in the immediate window type set DictContador = new Dictionary so the dictionary is initialised empty and add a watch for DictContador("a"). You will see "a" added as an item in the locals window.
Collections offer an alternative method that don't have this issue, they also show values rather than keys which may be more useful for debugging. On the other hand an Exists method is lacking so you would either need to add on error resume next and test for errors instead or add a custom collection class with an exists method added. There are trade-offs with both approaches.
I have a list box on a form and it works fine for what I want to do.
I am wanting to edit items on the form, this means populating the listbox and then selecting the relevant items.
My listbox contains a list of item sizes, i want to select the sizes which belong to the item being edited.
PLease can someone give me some pointers.
I tried me.lstItemSizes.SetSelected(i,true) but this only works for a single item.
Any help wil be much appreciated.
My Code:
Private Sub SelectItemSizes(ByVal itemID As Integer)
Dim itemSizes As IList(Of ItemSize) = _sizeLogic.GetItemSizes(itemID)
Me.lstItemSizes.SelectionMode = SelectionMode.MultiExtended
If (itemSizes.Count > 0) Then
For i As Integer = 0 To Me.lstItemSizes.Items.Count - 1
For x As Integer = 0 To itemSizes.Count - 1
If (CType(Me.lstItemSizes.Items(i), PosSize).SizeID = itemSizes(x).SizeID) Then
Me.lstItemSizes.SetSelected(i, True)
Else
Me.lstItemSizes.SetSelected(i, False)
End If
Next
Next
End If
End Sub
Did you set the selectionmode to multi?
You need to specify that in order to allow multiple selections.
Then you can do:
Dim i as Integer=0
For i=0 To Me.listBox.SelectedItems.Count -1
'display the listbox value
next i
Here is a screen shot:
After you set the property on the listbox then call setselected based on the values you want selected.
me.lstItemSizes.SetSelected(3,true)
me.lstItemSizes.SetSelected(4,true)
me.lstItemSizes.SetSelected(9,true)
Here you can add 20 numbers and only select the even.
Dim i As Integer
'load the list with 20 numbers
For i = 0 To 20
Me.ListBox1.Items.Add(i)
Next
'now use setselected
'assume only even are selected
For i = 0 To 20
If i Mod 2 = 0 Then
Me.ListBox1.SetSelected(i, True)
End If
Next
3rd edit
Look at the way you are looping, lets assume I create a list of integers, my vb.net is rusty I mainly develop in C#. But assume you did this:
Dim l As New List(Of Integer)
l.Add(2)
l.Add(6)
l.Add(20)
You only have three items in your list, so first loop based on the items on your list, then within the items in your listbox, you have it vice versa. Look at this:
Dim i As Integer
Dim l As New List(Of Integer)
l.Add(2)
l.Add(6)
l.Add(20)
'load the list with 20 numbers
For i = 0 To 20
Me.ListBox1.Items.Add(i)
Next
Dim lCount As Integer = 0
For lCount = 0 To l.Count - 1
For i = 0 To 20
If i = l.Item(lCount) Then
Me.ListBox1.SetSelected(i, True)
Exit For
End If
Next
Next
In the code my l is a list of just 3 items: 2, 6, and 20.
I add these items to l which is just a list object.
So now I have to loop using these 3 numbers and compare with my listbox. You have it the opposite you are looping on your listbox and then taking into account the list object.
Notice in my for loop that once the item in my list is found I no longer need to loop so I exit for. This ensures I dont overdue the amount of looping required. Once the item is found get out and go back to the count of your list object count.
After running my code here is the result
You have to change the ListBox.SelectionMode property in order to enable multiple-selection.
The possible values are given by the SelectionMode enum, as follows:
None: No items can be selected
One: Only one item can be selected
MultiSimple: Multiple items can be selected
MultiExtended: Multiple items can be selected, and the user can use the Shift, Ctrl, and arrow keys to make selections
So, you simply need to add the following line to the code you already have:
' Change the selection mode (you could also use MultiExtended here)
lstItemSizes.SelectionMode = SelectionMode.MultiSimple;
' Select any items of your choice
lstItemSizes.SetSelected(1, True)
lstItemSizes.SetSelected(3, True)
lstItemSizes.SetSelected(8, True)
Alternatively, you can set the SelectionMode property at design time, instead of doing it with code.
According to MSDN, SetSelected() can be used to select multiple items. Simply repeat the call for each item that needs to be selected. This is the example they use:
' Select three items from the ListBox.
listBox1.SetSelected(1, True)
listBox1.SetSelected(3, True)
listBox1.SetSelected(5, True)
For reference, this is the MSDN article.
Because my code had the following loops:
For i As Integer = 0 To Me.lstItemSizes.Items.Count - 1
For x As Integer = 0 To itemSizes.Count - 1
If (CType(Me.lstItemSizes.Items(i), PosSize).SizeID = itemSizes(x).SizeID) Then
Me.lstItemSizes.SetSelected(i, True)
Else
Me.lstItemSizes.SetSelected(i, False)
End If
Next
Next
The first loop loops through the available sizes and the second loop is used to compare the item sizes.
Having the following code:
Else
Me.lstItemSizes.SetSelected(i, False)
End If
Meant that even if item i became selected, it could also be deselected.
SOLUTION:
Remove Me.lstItemSizes.SetSelected(i, False) OR Include Exit For