I'm trying to dynamically assign a list to every combo box based on the values of a specific combo box. The idea is that the user picks a category from the specific combobox and all other combo boxes grab the items from that category in the form of a named list.
So the structure is like
Categories
Category 1
category 2
Category 1
Item 1
Item 2
And so on. I had this working on a fake set of names, but now that I'm using real named ranges, the code breaks. It is breaking on "For Each rng In ws.Range(str)" and stating that "method 'range' of object '_worksheet' failed.
This code works. Or worked. Then I changed ws to point to a different sheet of named ranges and now nothing works.
The value of CBOCategory is any value from a list of all named ranges, but it seems like Excel isn't seeing any of them! I tried to trigger even a listfill assignment instead of adding each item and got a similar error
Private Sub CBOCategory_Change()
'Populate dependent combo box with appropriate list items
'according to selection in cboCategoryList.
Dim rng As Range
Dim ws As Worksheet
Dim str, temp, cbName As String
Dim counter As Integer
Set ws = Worksheets("Item Master")
Dim obj As OLEObject
str = CBOCategory.Value
For Each obj In ActiveSheet.OLEObjects
If obj.Name = "CBOCategory" Then
' nothing
Else
temp = obj.Object.Value
obj.Object.Value = ""
For Each rng In ws.Range(str)
obj.Object.AddItem rng.Value
Next rng
obj.Object.Value = temp
End If
'MsgBox ("updated!")
Next obj
End Sub
The code works fine. The root cause of the issue is that the named ranges were being dynamically set by a formula. The formulas were not calculating properly when the code ran, so vba could not use a dynamically set named range to find another, also dynamically set named range.
The solution is to explicitly set the named ranges. Then the code works fine.
Related
Heya this is probably simple but I cannot figure out what is wrong.
I am trying to do .find for a specific date and change that selection to a user input date.
I have a userform to select a date from a combobox (date1_cbo). The combobox source is linked to dates on a worksheet (Backend). There is a textbox below for writing the new date to change it to (date1_txt). I keep getting an error
object variable or with block variable not set.
I have tried a few options without any luck here is my code:
Dim selection As Range
Dim check As Boolean
'input box validation
check = IsDate(date1_txt.Value)
If check = True Then
'find cell matching combobox
With Worksheets("Backend").Range("A1:A500")
Set selection = .Find(date1_cbo.Value) 'this is the problem
selection.Value = date1_txt.Value
End With
Else
End If
Interestingly .Find returns the range or Nothing. however because the combobox is linked to the cells I am searching through this should never return nothing... I dont understand why the error is occurring.
a variable named as 'selection' is bad coding practice but totally legal. Don't use such names for the sake of clarity.
Error 91 is caused when you are trying to read a property( .value) from null object. your selection variable is null cause date formats on the sheet and combobox are different.
Just convert to date before attempting to find it in sheet.
Set selection = .Find(CDate(date1_cbo.Value)) '/ once again, selection is valid but bad name for variable.
You are using a variable named Selection. VBA uses it as well. Rename your variable to anything else, rewrite your code and it should work. Even Selection1 is quite ok:
Public Sub TestMe()
Dim selection1 As Range
With Worksheets(1).Range("A1:A500")
Set selection1 = .Find("vi")
End With
If Not selection Is Nothing Then
selection1.Value = "some other value"
End If
End Sub
To change multiple values with Find() as here - A1:A10, then some possibility is to do it like this:
Public Sub TestMe()
Dim myRng As Range
With Worksheets(1).Range("A1:A500")
.Range("A1:A10") = "vi"
Set myRng = .Find("vi")
If Not myRng Is Nothing Then
Do Until myRng Is Nothing
myRng.Value = "New value"
Set myRng = .Find("vi")
Loop
End If
End With
End Sub
It is a bit slow, as far as it loops every time and it can be improved, if the range is united and replaced at once.
I have this code:
With Sheet1.Shapes("comboBox1").ControlFormat
.ListFillRange = "namedRange"
.AddItem "1.Item"
End With
But after that, just "1.Item" is in my Combo-Box and the dynamic range don't appear at all.
How can I add one Item and my Range to the Combo-Box?
EDIT
The dynamic range would work if I delete .AddItem:
With Sheet1.Shapes("comboBox1").ControlFormat
.ListFillRange = "namedRange"
End With
My Question is if there is a possibility to combine those to not in a range, but rather separated from each other.
Thank you very much in advance for your answers...
If I understood your post correctly, you want to add another Item to the items in your "namedRange" and show all these items in your worksheet ComboBox (which is actually a drop-down in your worksheet).
(modify "Sheet2" to your sheet's name).
Sub PopulateCombo_fromArray()
Dim ComboArray As Variant
'clear Combo-Box from previous runs >> modify "Sheet2" to your sheet's name
Worksheets("Sheet2").Shapes("ComboBox1").ControlFormat.RemoveAllItems
' reading the NamedRange into a 1-dimension array
ComboArray = Application.Transpose(Range("namedRange").Value)
ReDim Preserve ComboArray(UBound(ComboArray))
' add another element to the array (outside the "namedRange")
ComboArray(UBound(ComboArray)) = "1.Item"
' populate "ComboBox1" with array
Worksheets("Sheet2").Shapes("comboBox1").ControlFormat.List = ComboArray
End Sub
Must you use "Shapes"?
if not, you can fill a combobox with a named range like this :
With Sheet1.ComboBox1
.List = Application.Transpose(Range("namedRange"))
.AddItem "1.Item"
End With
I need to add combo box(ActiveX Control) or Data Validation as drop down list.
I have a range of 15 values like, high, low, medium,etc...
Have created named range called "priorityvalue".
I can create a dropdown list using combo box by adding named range under ListFillRange in the properties or data validation list by giving named range.
But my concern, I need to dropdown list for 58cells with same values mentioned above. Its tedious job to create combo box for all cells. Please suggest me better option here.
Data validation list serves the purpose. However, it makes user to scroll through dropdown list on each cell unlike combo box it has no input box..
Please suggest
Paste the below code in 'ThisWokbook'
Private Sub Workbook_Open()
Dim oItem As Object
For Each oItem In Worksheets(1).OLEObjects
If TypeName(oItem.Object) = "ComboBox" Then
If Len(oItem.Object.Value) > 0 Then
oItem.Object.Value = ""
End If
End If
Next
Set oItem = Nothing
End Sub
NOTE: There are caveats to this. Above code will reset all comboboxes in your worksheet (also, I've set the worksheet to the first worksheet in the workbook, you might want to make that dynamic). If you don't want it to reset all comboboxes and only do the ones you added via the function, you can use the name format to filter the ones you want to clear
Hope this helps
Try this:
Sub AddComboBoxToColumns(ByVal oRange As Excel.Range)
Dim oOLE As OLEObject
Dim oCell As Object
' Loop through all the cells in the range
For Each oCell In oRange.Cells
' Add ComboBox in each cell
With oCell
Set oOLE = .Parent.OLEObjects.Add("Forms.combobox.1")
oOLE.Top = .Top
oOLE.Left = .Left
oOLE.Width = .Width
oOLE.Height = .Height
oOLE.Name = "ComboBox" & .Address(False, False)
oOLE.Object.List = Array("Test1", "Test2")
End With
Next
Set oOLE = Nothing
End Sub
NOTE: Call the above function with the range of cells you want to add ComboBox to. You will have to change the Array to use the values you want (you can type them in there or give the range where your existing values are)
I know that this probably isn't the most ideal way to to do this but just bear with me.
I have a document with a few tables on it. I'm using a userform to search the tables/sub-categories and return the relevant values. I want to select the sub categories with a range of option buttons on a userform, these will in turn set the range for the search function to look within. I also want to dynamically update the option buttons if a new table was to be added or anything along those lines.
The only thing that differentiates the title of a sub-category/table, and the items within it, is that the title of a sub-category/table is bold. So what I'm looking to do is search the first column of the spreadsheet and return the names of any entries in bold. These values are then used to set the names of the option buttons :).
The following function is my attempt at finding the text entities in column a that are in bold, returning them and setting each to an individual variable to be used in another function. The bold1 .... variables are all globally defined variables as I need them in another sub, as is the page variable which contains the relevant page to be used. Currently the code returns an error stating "variable or with block not set" and using the debugger I can see that bold1 .... and all the other boldx variables have no value set. Does anybody know whats going on/how to fix this function.
Thanks in advance :)
Sub SelectBold()
Dim Bcell As Range
For Each Bcell In Worksheets(Page).Range("A1:A500")
If Bcell.Font.Bold = True Then
Set bold1 = Bcell
End If
Next
End Sub
EDIT: I simplified the above function, to remove clutter and help narrow in on the issue. I want the above function to store the contents of the found cell (any cell in the document in bold at this stage) in the variable bold1
This will return an array of values from bold cells in column A of Page.
You can fill a combo or list box with theses values using their list property.
ComboBox1.List = getSubCategories("Sheet1")
Function getSubCategories(Page As String) As String()
Dim arrSubCategories() As String
Dim count As Long
Dim c As Range
With Worksheets(Page)
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
If c.Font.Bold Then
ReDim Preserve arrSubCategories(count)
arrSubCategories(count) = c.Value
count = count + 1
End If
Next
End With
getSubCategories = arrSubCategories
End Function
you may find useful to have a Range returned with subcategories cells found:
Function SelectBold(Page As String, colIndex As String) As Range
With Worksheets(Page)
With .Range(colIndex & "1", .Cells(.Rows.Count, colIndex).End(xlUp)).Offset(, .UsedRange.Columns.Count)
.FormulaR1C1 = "=if(isbold(RC[-1]),"""",1)"
.Value = .Value
If WorksheetFunction.CountA(.Cells) < .Rows.Count Then Set SelectBold = Intersect(.SpecialCells(xlCellTypeBlanks).EntireRow, .Parent.Columns(1))
.Clear
End With
End With
End Function
Function IsBold(rCell As Range)
IsBold = rCell.Font.Bold
End Function
to be possibly exploited as follows:
Option Explicit
Sub main()
Dim subCategoriesRng As Range, cell As Range
Set subCategoriesRng = SelectBold(Worksheets("bolds").Name, "A") '<--| pass worksheet name and column to search in
If Not subCategoriesRng Is Nothing Then
For Each cell In subCategoriesRng '<--| loop through subcategories cells
'... code
Next cell
End If
End Sub
I'm having trouble with my Listbox. When I run the following code for the first time, it always runs showing only 1 date which is 30/12/1899. The range that I've specified only contains 6 dates which are 8/1/2014, 9/1/2014, 14/1/2014, 24/1/2014, 24/1/2014 and 02/02/2014.
Once I stop the form and run it again, all the required dates show up.
I've just started learning VBA on Excel so I'm still struggling to understand the concepts.
Is there something that I'm missing? The reason for no duplicates is that I can't show the 2 dates (24/01/2014).
Private Sub UserForm_Activate()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim wksJobDetail As Worksheet
'The items are in A2:A7
Set AllCells = Range("A2:A7")
'Point the variable to JobSchedule worksheet
Set wksJobDetail = Application.Workbooks("xxxxx.xlsm").Worksheets("JobSchedule")
wksJobDetail.Activate
'Statement ignores any errors regarding duplicates and duplicate dates aren't added
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
'Add non-duplicated items into lstDate
For Each Item In NoDupes
JobDetail.lstDate.AddItem Item
Next Item
End Sub
Set AllCells = Range("A2:A7") will reference the active worksheet which may or may not be wksJobDetail.
The second time you run it wksJobDetail has been activated.
Try putting the Set AllCells = Range("A2:A7") statement after:
Set wksJobDetail = Application.Workbooks("xxxxx.xlsm").Worksheets("JobSchedule")
wksJobDetail.Activate
I think it has something to do with how you format your data in Excel and the proper way of referencing source range.
Try this:
First, check if the dates are correctly entered as dates in Excel like below.
Then make this line explicit:
Set AllCells = Range("A2:A7")
and change to this:
Set AllCells = Sheets("JobSchedule").Range("A2:A7")
Now, run your code which I've rewritten below adding On Error Goto 0.
Dim AllCells As Range, Cell As Range, Item
Dim NoDupes As New Collection
Set AllCells = Sheets("JobSchedule").Range("A2:A7")
On Error Resume Next '~~> Ignore Error starting here
For Each Cell In AllCells
NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
On Error GoTo 0 '~~> Stops ignoring error
For Each Item In NoDupes
JobDetail.lstDate.AddItem Item
Next Item
And that should give you the result you want. Also, I suggest to use Initialize Event instead of Activate.
Everytime you use OERN, do not forget to use OEG0 to reset the error handling.
Otherwise, you will not be able to trap other errors not related to the adding existing item in Collection.
Bonus:
Another way to do this is to use a Dictionary instead. You need to add reference to Microsoft Scripting Runtime. I rewrote part of your code which will have the same effect. The advantage of a Dictionary is that it offers other helpful properties that you can use.
Private Sub UserForm_Initialize()
Dim AllCells As Range, Cell As Range
Dim d As Dictionary
Set AllCells = Sheets("Sheet1").Range("A2:A7")
Set d = New Dictionary
For Each Cell In AllCells
d.Item(Format(CDate(Cell.Value), "dd/mm/yyyy")) = _
CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
JobDetail.lstDate.List = d.Keys
End Sub
As you can see, we removed one Loop by using Keys property which is an array of all unique keys. I hope this somehow helps.