Error 9: Subscript out of range - vba

I have a problem in excel Vba when I try to run this code, I have an error of subscript out of range:
Private Sub UserForm_Initialize()
n_users = Worksheets(Aux).Range("C1").Value
Debug.Print Worksheets(Aux).Range("B1:B" & n_users).Value
ListBox1.RowSource = Worksheets(Aux).Range("B1:B" & n_users).Value
ComboBox1.RowSource = Worksheets(Aux).Range("B1:B" & n_users).Value
ComboBox2.RowSource = Worksheets(Aux).Range("B1:B" & n_users).Value
End Sub
And Debug.Print works well, so the only problem is in Range("B1:B" & n_users).Value.

If the name of your sheet is "Aux", change each Worksheets(Aux) reference to Worksheets("Aux"). Unless you make Aux a string variable, for example:
Dim Aux As String
Aux = "YourWorksheetName"
n_users = Worksheets(Aux).Range(C1).Value
you must use quatations around sheet references.

Firstly, unless you have Aux defined somewhere in the actual code, this will not work. The sheet-name reference must be a string value, not an empty variable (which ARich explains in his answer).
Second, the way in which you are trying to populate the rowsource value is incorrect. The rowsource property of a combobox is set using a string value that references the target range. By this I mean the same string value you would use in an excel formula to reference a cell in another sheet. For instance, if your worksheet is named "Aux" then this would be your code:
ComboBox1.RowSource = "Aux!B1:B" & n_users
I think you can also use named ranges. This link explains it a little.

I can't see how you can get an Error 9 on that line. As others have pointed out repeatedly, the place you'll get it is if the variable Aux doesn't have a string value representing the name of a worksheet. That aside, I'm afraid that there is a LOT wrong with that code. See the comments in the below revision of it, which as near as I can figure is what you're trying to get to:
Private Sub UserForm_Initialize()
'See below re this.
aux = "Sheet2"
'You should always use error handling.
On Error GoTo ErrorHandler
'As others have pointed out, THIS is where you'll get a
'subscript out of range if you don't have "aux" defined previously.
'I'm also not a fan of NOT using Option Explicit, which
'would force you to declare exactly what n_users is.
'(And if you DO have it declared elsewhere, I'm not a fan of using
'public variables when module level ones will do, or module
'level ones when local will do.)
n_users = Worksheets(aux).Range("C1").Value
'Now, I would assume that C1 contains a value giving the number of
'rows in the range in column B. However this:
'*****Debug.Print Worksheets(aux).Range("B1:B" & n_users).Value
'will only work for the unique case where that value is 1.
'Why? Because CELLS have values. Multi-cell ranges, as a whole,
'do not have single values. So let's get rid of that.
'Have you consulted the online Help (woeful though
'it is in current versions) about what the RowSource property
'actually accepts? It is a STRING, which should be the address
'of the relevant range. So again, unless
'Range("B1:B" & n_users) is a SINGLE CELL that contains such a string
'(in which case there's no point having n_users as a variable)
'this will fail as well when you get to it. Let's get rid of it.
'****ListBox1.RowSource = Worksheets(aux).Range("B1:B" & n_users).Value
'I presume that this is just playing around so we'll
'ignore these for the moment.
'ComboBox1.RowSource = Worksheets(aux).Range("B1:B" & n_users).Value
'ComboBox2.RowSource = Worksheets(aux).Range("B1:B" & n_users).Value
'This should get you what you want. I'm assigning to
'variables just for clarity; you can skip that if you want.
Dim l_UsersValue As Long
Dim s_Address As String
l_UsersValue = 0
s_Address = ""
'Try to get the n_users value and test for validity
On Error Resume Next
l_UsersValue = Worksheets(aux).Range("C1").Value
On Error GoTo ErrorHandler
l_UsersValue = CLng(l_UsersValue)
If l_UsersValue < 1 Or l_UsersValue > Worksheets(aux).Rows.Count Then
Err.Raise vbObjectError + 20000, , "User number range is outside acceptable boundaries. " _
& "It must be from 1 to the number of rows on the sheet."
End If
'Returns the cell address
s_Address = Worksheets(aux).Range("B1:B" & n_users).Address
'Add the sheet name to qualify the range address
s_Address = aux & "!" & s_Address
'And now that we have a string representing the address, we can assign it.
ListBox1.RowSource = s_Address
ExitPoint:
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description
Resume ExitPoint
End Sub

Related

Excel 2016 VBA - Compare 2 PivotTables fields for matching values

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.

VBA Form - Vlookup cell and assign value to that cell

Encountering an issue in a VBA regarding vlookup function.
I have 2 comboboxes and 6 Textboxs for user input.
I want to use a vlookup (or index,Match(),Match()) to look up a cell in a data table and assign the values from the textboxes to these cells.
When I run the code for what I believe should work, it is returning object errors.
Private Sub CommandButton2_Click()
Dim MonthlyTable As Range
Set MonthlyTable = Sheets("DATA Monthly").Range("A6:AE400")
Dim ColumnRef As Range
Set ColumnRef = Sheets("Drivers").Range("N11")
' Assign CB2 value to M11 cell reference so it can be converted to a column ref in N11.
Sheets("Drivers").Range("M11").Value = ComboBox2.Value
Dim CB1Value As String
CB1Value = "Joiners" & ComboBox1.Value
Dim CB2Value As String
CB2Value = ComboBox2.Value
MsgBox CB1Value & " " & CB2Value
Dim tb1value As Range
tb1value = Application.WorksheetFunction.VLookup(CB1Value, MonthlyTable, ColumnRef, False)
tb1value.Value = TextBox1.Value
Unload Me
End Sub
I am at a loss for what to do here as I feel like it should be this simple!
Thanks in advance.
Edit. Further digging indicates that you cannot select a cell you are vlookup'ing as this commands only returns a value it does not actually select the cell for my intents and purposes.
not really clear to me you actual aim, but just following up your desire as stated by:
I want to use a vlookup (or index,Match(),Match()) to look up a cell
in a data table and assign the values from the textboxes to these
cells
you may want to adopt the following technique:
Dim tb1value As Variant '<--| a variant can be assigned the result of Application.Match method and store an error to be properly cheeked for
tb1value = Application.Match(CB1Value, MonthlyTable.Column(1), 0) '<--| try finding an exact match for 'CB1Value' in the first column of your data range
If Not IsError(tblvalue) Then MonthlyTable(tb1value, columnRef.Value).Value = TextBox1.Value '<--| if successful then write 'TextBox1' value in data range cell in the same row of the found match and with `columnRef` range value as its column index
Excel uses worksheet functions to manipulate data, VBA has different tools, and when you find yourself setting cell values on a sheet via VBA so that some worksheet function can refer to them it is time to look for a true VBA solution. I suggest the following which, by the way, you might consider running on the Change event of Cbx2 instead of a command button.
Private Sub Solution_Click()
' 24 Mar 2017
Dim MonthlyTable As Range
Dim Rng As Range
Dim Lookup As String
Dim Done As Boolean
Set MonthlyTable = Sheets("DATA Monthly").Range("A2:AE400")
' take the lookup value from Cbx1
Lookup = ComboBox1.Value
Set Rng = MonthlyTable.Find(Lookup)
If Rng Is Nothing Then
MsgBox Chr(34) & Lookup & """ wasn't found.", vbInformation, "Invalid search"
Else
With ComboBox2
If .ListIndex < 0 Then
MsgBox "Please select a data type.", vbExclamation, "Missing specification"
Else
TextBox1.Value = MonthlyTable.Cells(Rng.Row, .ListIndex + 1)
Done = True
End If
End With
End If
If Done Then Unload Me
End Sub
There are two points that need explanation. First, the form doesn't close after a rejected entry. You would have to add a Cancel button to avoid an unwanted loop where the user can't leave the form until he enters something correct. Note that Done is set to True only when the search criterion was found And a value was returned, and the form isn't closed until Done = True.
Second, observe the use of the ListIndex property of Cbx2. All the items in that Cbx's dropdown are numbered from 0 and up. The ListIndex property tells which item was selected. It is -1 when no selection was made. If you list the captions of your worksheet columns in the dropdown (you might do this automatically when you initialise the form) there will be a direct relationship between the caption selected by the user (such as "Joiners") and the ListIndex. The first column of MonthlyTable will have the ListIndex 0. So you can convert the ListIndex into a column of MonthlyTable by adding 1.
I think it is better to use "find" in excell vba to select a cell instead of using vlookup or other methods.

Error runtime 91 and 429

This code feels like Schrodinger is executing it. If I open the project and run the code, I won't get any errors at all. If I view the code to edit or add anything, the first time I run the code, I get 'Run-time error 91'. If I try to run it a second time, making no changes, I get 'Run-time error 429' (ActiveX component can't create object).
What I'm trying to achieve is to find the row (BuildSel) in a range on worksheet (Ref) that has the same value as what's selected in a list on a userform (BuildList). Then once the row is found, to take data from that row and columns A and B, and put them in textbox's on my userform. Is my code right and ActiveX making the error? I apologize for terrible coding too.
EDIT: The listbox is on a multipage on my userform. I first noticed the issue today when I tried adding another listbox on a different page.
Private Sub BuildList_Click()
Dim Ref As Worksheet, BuildSel As Long
Set Ref = ThisWorkbook.Sheets("Ref")
BuildSel = Ref.Range("B2", Ref.Range("B" & Rows.Count).End(xlUp)).Find(BuildList.Value, lookat:=xlPart).Row
BuilderText.Value = Ref.Range("A" & BuildSel).Value
CompNameText.Value = Ref.Range("B" & BuildSel).Value
End Sub
Not sure why altering 'BuildSel' to variant makes it work, but the code as it stands has no error checking for when there is no matching list item to be found
The following code should be better suited for usage:
Private Sub BuildList_Click()
Dim Ref As Worksheet: Set Ref = ThisWorkbook.Sheets("Ref")
Dim BuildSel As Range
With Ref
Set BuildSel = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Find _
(BuildList.Value, lookat:=xlPart)
If Not BuildSel Is Nothing Then
BuilderText.Value = .Range("A" & BuildSel.Row).Value
CompNameText.Value = .Range("B" & BuildSel.Row).Value
Else
BuilderText.Value = ""
CompNameText.Value = ""
End If
End With
End Sub

VBA Error 1004 When Calling A Module with an Argument

This is my first post so bear with me.
I get a run-time error 1004 when I try calling a module from my user form and passing on an argument. I'm sure the answer is pretty obvious but I'm new to passing on arguments.
From User Form when clicking submit button:
Sub SubmitButton_Click()
Dim addRowValue As Integer
addRowValue = LineBox.Value
MsgBox "Add " & addRowValue & " rows."
Call Sheet1.ResizeTable(addRowValue)
End Sub
From Sheet1:
Sub ResizeTable(addRowValue As Integer)
Dim rng As Range
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("DATA_INPUT")
Set rng = Range("DATA_INPUT[#All]").Resize(tbl.Range.Rows.Count + _
addRowValue, tbl.Range.Columns.Count)
tbl.Resize rng
End Sub
Call Sheet1.ResizeTable works fine but when I add the argument is when I get the error. Also, the module ResizeTable() works fine when I change the variable addRowValue to a set number and run it.
Thanks for any help!
Problem is you are assigning a string to variable of type integer.
Change
addRowValue = LineBox.Value
To
addRowValue = CInt(LineBox.Value)
EDIT: You might also want to ensure the user enters a numeric value so have something like:
If IsNumeric(LineBox.Value) Then
addRowValue = CInt(LineBox.Value)
Else
MsgBox "Please enter numeric value", vbCritical
LineBox.Value = ""
End If

vLookup error for VBA in Excel

I have a form that has a list of items from which it unhides the relevant item-sheet based on the form selection. Due to the length of item name, each item is assigned an ID. The vlookup function is meant to retrieve the relevant ID based on the matching of names in another sheet.
The code is as follows.
The fundName value being passed in is "AX - Arnold Xchange Securities (USD)".
The fundID is located on the 5th column of the array being searched.
The fundID definitely exists
The problem here is that it gives me a runtime error where it cannot get the vLookup property of the function class. Error 1004
Private Sub FundLookupImage_Click()
Dim fundName As String
Dim fundSheetName As String
Dim ws As Worksheet
Set ws = Worksheets("DownloadTable")
MsgBox ws.UsedRange.EntireRow.Count
fundName = Me.FundList.Value
fundName = """" & fundName & """"
MsgBox fundName
fundSheetName = CStr(Application.WorksheetFunction.VLookup(fundName, ws.Range("A:F"), 5, True))
MsgBox fundSheetName
Unload Me
End Sub
I've tested the vLookup method on excel itself and it retrieves the correct ID
Using VLookup makes me crazy always when I have to use it, please try this:
DIM searchResult AS variant
searchResult = 0
On Error Resume Next
searchResult = Application.WorksheetFunction.VLookup(fundName, ws.Range("A:F"), 5, 0)
fundSheetName = CStr(searchResult)