So I have this code to loop through selected items in a listbox and add them to a collection. For some reason it is throwing the compile error "Argument Not Optional" on the commented out line that is trying to add the selected item to the Collection.
However, the line adding "test" works fine.
I know this is an optional argument because it even gives me Intellisense popup to use "Add". So I'm pretty confused.
If optPaste = True Then
'Paste Code
Else
'Read In Selection
Dim tempArray As Variant
Dim i As Integer
Dim colSelected As Collection
Set colSelected = New Collection
colSelected.Add ("test")
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
tempArray = Split(Me.ListBox1.List(i), " - ")
' colSelected.Add = tempArray(1)
End If
Next i
MsgBox (colSelected(1))
End If
Related
Hi please can someone help, Excel 2016 VBA PivotTable objects. I rarely develop in Excel VBA.
Overall goal:
Compare a single column [P_ID] value list from PivotTable2 against PivotTable1 if they exist or not to enable filtering on those valid values in PivotTable1.
I have some Excel 2016 VBA code which I have adapted from a previous answer from a different internet source.
Logic is: gather data from PivotTable2 from the ComparisonTable dataset (in PowerPivot model), field [P_ID] list of values. Generate a test line as input into function to test for existence of field and value in PivotTable1 against the Mastertable dataset, if true add the line as valid if not skip the line.
Finally filter PivotTable1 with the VALID P_ID values.
It works to a point until it gets to the bFieldItemExists function which generates an error:
Run-time error '1004'
Unable to get the PivotItems property of the PivotField class
Can someone please correct the way of this not working?
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim MyArray As Variant, _
ar As Variant, _
x As String, _
y As String, _
str As Variant
MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
For Each ar In MyArray
x = "[MasterTable].[P_ID].&[" & ar & "]"
If ar <> "" And bFieldItemExists(x) = True Then
If str = "" Then
str = "[MasterTable].[P_ID].&[" & ar & "]"
Else
str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
Dim strTemp As Variant
' This line does not work!?
strTemp = ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").PivotItems(strName)
If Err = 0 Then bFieldItemExists = True Else bFieldItemExists = False
End Function
The 1004 error occurred due to the use of square brackets [ ]. Remove those.
You also need to use the key word Set when you set an object equal to something. For example Set MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.[P_ID").DataRange.
If you don't use Set you will get a VBA run-time error dialog that says Run-time error '91': Object variable or With block variable not set
I cannot guarantee that my edits will completely solve your problem since I don't have your data set and cannot fully test your code. You will need to use the Debug mode in the VBA editor and single step through the code. To this set a breakpoint on the Set mDataRange = Active.... To set a breakpoint go to the Debug menu and choose the "Toggle Breakpoint" sub-menu item or you can press F9 to set the breakpoint.
Now when you make a change to the Pivot table, the Worksheet_PivotTableUpdate event will fire and the code will top execution at that point.
After the code stops executing due to the breakpoint, you can press the F8 key to single step through your code. If you want to resume execution to the next breakpoint you can press F5. Also when you get the VBA error dialog box, you can hit Debug and then use the F8 key to single step or use the debug windows to see what your variables and objects contain. I'm sure there are some good youtube videos on VBA debugging.
As you single step through the code, you can observe what each variable/object contains using the Immediate window, the Watches window and the Locals window. To open these windows, go to the menu item View and click on each of these sub-menu items.
Here's how you need to edit your code before debugging.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Better practice is to not use the underscore character to
'continue a Dim declaration line
Dim mDataRange As Range
Dim ar As Range
Dim x As String
Dim y As String
Dim str As Variant
'Use Set to assign the object mDataRange a reference to the the right
'hand side of the equation. Remove the square brackets
'MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
Set mDataRange = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.P_ID").DataRange
For Each ar In mDataRange
'You need to specify what proprerty from ar you
'want to assign to x. Assuming the value stored in
'ar.Value2 is a string, this should work.
'We use value2 because it is the unformmated value
'and is slightly quicker to access than the Text or Value
'properties
'x = "[MasterTable].[P_ID].&[" & ar & "]"
x = "MasterTable.P_ID." & ar.Value2
'Once again specify the Value2 property as containing
'what value you want to test
If ar.Value2 <> "" And bFieldItemExists(x) = True Then
If str = "" Then
'Remove the square brackets and use the specific property
'str = "[MasterTable].[P_ID].&[" & ar & "]"
str = "MasterTable.P_ID." & ar.Value2
Else
'Remove the square brackets and use the specific property
'str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
str = str & "," & "MasterTable.P_ID." & ar.Value2
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
'Remove square brackets
'ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
'Declare a PivotItem to accept the return value
Dim pvItem As PivotItem
'Since you want to trap for an error, you'll need to let the VBA runtime know
'The following code is a pseudo Try/Catch. This tells the VBA runtime to skip
'the fact an error occured and continue on to the next statement.
'Your next statement should deal with the error condition
On Error Resume Next
'Use Set whenever assigning an object it's "value" or reference in reality
Set pvItem = ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").PivotItems(strName)
'Assuming that an error gets thrown when strName is not found in the pivot
'Err is the error object. You should access the property you wish to test
If Err.Number = 0 Then
bFieldItemExists = True
Else
bFieldItemExists = False
End If
'Return to normal error functioning
On Error GoTo 0
End Function
Finally, I realize that some of this should be in the comments section, but there was too much I needed to explain to help Learner74. BUT most importantly, I hope I helped him. I have used so many suggestions, recommendations and explanations from the VBA Stack Overflow exchange through the years, I just want to pay it back by paying it forward.
Additional USEFUL Links:
Chip Pearson is the go to site and person for all things VBA
Paul Kelly's Excel Macro Mastery is another go to site for Excel and VBA questions.
Microsoft Excel Object Model which is sometimes useful, but needs improvement. Too many of the objects lack examples, but can at least point you in the right direction.
I have been working on Excel and VBA and I am trying to figure out how to deselect various fields from my slicer and only select few.
I try to read the slicer Cache and then iterate over various items within the slicer. I am able to read the values of the items within the slicer, but i am unable to deselect them. It keeps on throwing up an "application-defined or Object-defined error" with the error code 1004.
I am sharing the code snippet i am facing difficulty with.
Sub SelectFiscalWeeks()
Dim slcCache As SlicerCache
Dim slcItem As SlicerItem
FalseVar = False
Application.StatusBar = "Filtering out last 13 Week's Data"
Set slcCache = ThisWorkbook.SlicerCaches("Slicer_Date.Fiscal_Week")
slcCache.ClearManualFilter
For Index = 1 To slcCache.SlicerCacheLevels.Count
Worksheets("A").Cells(Index + 1, "N").Value = Index
j = 0
For Each slcItem In slcCache.SlicerCacheLevels(Index).SlicerItems
Worksheets("A").Cells(j + 1, "P").Value = slcItem.Name
j = j + 1
slcItem.Selected = FalseVar
Next
Next
'Set slcCache.VisibleSlicerItems = Array("[DT].[FW].&[201701]")
Set slcCache = Nothing
Application.StatusBar = False
End Sub
In the above code I am able to read the Slicer Item names by using slcItem.Name, but I am unable to Execute either of the following statements:
slcItem.Selected = FalseVar
Set slcCache.VisibleSlicerItems = Array("[DT].[FW].&[201701]")
Executing these statements throws up an error "application-defined or Object-defined error" with the error code 1004.
I have been trying debugging for more than an hour but am unable to figure out the cause. It might be something basic, but can you please help me identify what might be wrong with my code?
Yea, I've been debugging for couple hours with the same problem you have.
Finally I found I should use VisibleSlicerItems instead of setting .selected to be true/false.
Try slcCache.VisibleSlicerItems = Array("[DT].[FW].&[201701]") without Set.
Here is my code as example.
Hope could help you.
Option Explicit
Sub Test()
Dim sc As SlicerCache
Dim si As SlicerItem
Dim list As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_product_name")
For Each si In sc.SlicerCacheLevels(1).SlicerItems
If InStr(si.Value, "Boxers") > 0 Then
'this if loop creates an Array for VisibleSlicerItems
If IsEmpty(list) Then
list = Array(si.Name)
Else
ReDim Preserve list(UBound(list) + 1)
list(UBound(list)) = si.Name
End If
End If
Next
sc.VisibleSlicerItemsList = list
End Sub
I have a two list boxes with one button when the user can click the button move all the list item from listbox1 to listbox2. when the listbox1 is becomes empty app is getting restarted IN EXCEL 2016.
My Code is
For i = 1 To ThisWorkbook.Sheets("MultiSheet").ListBoxes(strFromlb).listCount
ThisWorkbook.Sheets("MultiSheet").ListBoxes(strTolb).AddItem ThisWorkbook.Sheets("MultiSheet").ListBoxes(strFromlb).List(1)
ThisWorkbook.Sheets("MultiSheet").ListBoxes(strFromlb).RemoveItem (1)
Next i
Here strFromLb is clearing the values but when it clearing last value my VBA App is excel has been restarted.
Then I have tried code to clear the listbox
ThisWorkbook.Sheets("MultiSheet").ListBoxes(strFromlb).ControlFormat.RemoveAllItems
ThisWorkbook.Sheets("MultiSheet").ListBoxes(strFromlb).Items.Clear
The error is
"Object doesnt supported to property or method"
Then
ThisWorkbook.Sheets("MultiSheet").ListBoxes(strFromlb).Clear
This code I got the 400 error. so kindly help me.
Worksheets("MultiSheet").ListBoxes(strFromlb).ControlFormat.RemoveAllItems
Reference: The Complete Guide to Excel VBA Form Control ListBoxes
There are two type listbox controls for the worksheet Forms control and MsForms ActiveX control. getListBox will return get either one.
You code has a couple of syntax errors in it
Listbox.List returns a 0 based array
You don't use parentheses when using RemoveItem because it is a not a function
Dim lBoxFrom As Object, lBoxTo As Object
Set lBoxFrom = getListBox("MultiSheet", strFromlb)
Set lBoxTo = getListBox("MultiSheet", strTolb)
For i = 0 To lBoxFrom.ListCount - 1
lBoxTo.AddItem lBoxFrom.List(1)
lBoxFrom.RemoveItem 1
Next
or
lBoxTo.List = lBoxFrom.List
lBoxFrom.Clear
Sub Test()
Const WORKSHEET_NAME = "Sheet1"
Const strFromlb = "BoxFrom"
Const strTolb = "BoxTo"
Dim lBoxFrom As Object, lBoxTo As Object
Dim i As Integer
Set lBoxFrom = getListBox(WORKSHEET_NAME, strFromlb)
Set lBoxTo = getListBox(WORKSHEET_NAME, strTolb)
lBoxFrom.AddItem "A"
lBoxFrom.AddItem "B"
lBoxFrom.AddItem "C"
For i = 0 To lBoxFrom.ListCount - 1
lBoxTo.AddItem lBoxFrom.List(0)
lBoxFrom.RemoveItem 0
Next
End Sub
Function getListBox(WorkSheetName As String, ListBoxName As String) As Object
Dim lBox As Object
On Error Resume Next
Set lBox = Worksheets(WorkSheetName).ListBoxes(ListBoxName)
On Error GoTo 0
If lBox Is Nothing Then
On Error Resume Next
Set lBox = Worksheets(WorkSheetName).Shapes(ListBoxName).OLEFormat.Object.Object
On Error GoTo 0
End If
Set getListBox = lBox
End Function
I'm using Excel VBA Userforms and I'm trying to fill a ComboBox but I'm receiving the error Could not set the Column property. Type mismatch.
The ComboBox has it's ColumnCount property set to 3.
I'm using the code below to fill the ComboBox:
Dim i As Long
Dim varList As Variant
With UF_Main
'Get CM list
With .cbNAEmployee
.Clear
varList = fGetCMs
If Not isArrayEmpty(varList) Then
For i = LBound(varList, 2) To UBound(varList, 2)
.AddItem varList(0, i)
.Column(1, i) = varList(1, i)
.Column(2, i) = varList(2, i)
Next i
End If
End With
End With
The debugger flags the With UF_Main line as the offending line but this only occurs at the start of the third loop (it should loop 1000+ times).
When highlighting the line whilst debugging, it shows <Object variable or With block variable not set>.
There's nothing else occurring to change any of the properties within the UserForm / controls. What could be causing the error?
In a dropdown list I have a few items. Can I, when I select an item, get the position of that item in the list as a number?
If you are looking for the index of a Data Validation list, this is what I'd do:
Put the following code in the ThisWorkbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ValidationIndex As Long
Dim rngTest As Excel.Range
'assumes the data validation is in a cell named "rngTest"
On Error Resume Next
Set rngTest = Sh.Range("rngTest")
If rngTest Is Nothing Then
Exit Sub
End If
On Error GoTo 0
If Not Intersect(ActiveCell, Sh.Range("rngTest")) Is Nothing Then
ValidationIndex = GetValidationIndex
MsgBox ValidationIndex
End If
End Sub
Put this function in the ThisWorkbook module also, or else in any regular module:
Function GetValidationIndex() As Long
'returns a 1-based index
Dim rngTest As Excel.Range
Dim varValidationString As Variant
Dim ErrNumber As Long
Dim i As Long
With ActiveCell.Validation
If .Type = xlValidateList Then '3
On Error Resume Next
Set rngTest = ActiveCell.Parent.Range(.Formula1)
'I do this goofy thing with ErrNumber to keep my indenting and flow pretty
ErrNumber = Err.Number
On Error GoTo 0
'if the Validation is defined as a range
If ErrNumber = 0 Then
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
Exit Function
'if the validation is defined by comma-separated values
Else
varValidationString = Split(.Formula1, ",")
For i = LBound(varValidationString) To UBound(varValidationString)
If varValidationString(i) = ActiveCell.Value2 Then
GetValidationIndex = i + 1
Exit Function
End If
Next i
End If
End If
End With
End Function
If you are using a list or combo box, ListIndex would seem to be what you are after.
VB Help for ListIndex property: Returns or sets the index number of the currently selected item in a list box or combo box. Read/write Long. Remarks. You cannot use this property with multiselect list boxes.
If nothing is selected, ListIndex's value is -1. If memory serves, it is a zero based index.
ListIndex cannot be set at design time so it is not listed in the properties window.
When entering your code, type the list box name then dot and the editor displays all the available properties. Scroll down the list, note any that look interesting, then look them up.
I think it is not necessary to use a function. You can get it by using only Match function, like in above Doug's answer.
Dim GetValidationIndex as Integer
Dim rngTest as Range
' Get the validation list
With ActiveCell.Validation
Set rngTest = ActiveCell.Parent.Range(.Formula1)
end with
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
The function GetValidationIndex is good.
However, for some regional settings the line varValidationString = Split(.Formula1, ",") is not valid, because the character used to separate the different values is ";"
I suggest use:
varValidationString = Split(.Formula1, Application.International(xlListSeparator))