I am trying to use Collection to retrieve unique items in a range.
The code works well with string items. But if I replace the string with numeric items, using the same code, the collection is empty after run. No items added. No errors found.
Would very much appreciate any help!!!
Sub unique_val()
Dim unique As New Collection
Dim cell As Range
Dim i As Integer
'Updating collection items
On Error Resume Next 'in order to ignore key repeating
For Each cell In Sheet1.Range("a1:c9")
unique.Add cell.Value, cell.Value
Next
On Error GoTo 0
'Print collection items to sheet
For i = 1 To unique.Count
Cells(i, 5) = unique(i)
Next i
End Sub
Example of data that the code works on:
Data that code doesnt work:
Related
I am developing an application, in excel with VBA forms. in one form I have a combobox to that let user select customer name, the rowsource of this combobox is a named range (name column of customers table). Everything working fine but I need to add 1 or more additional items in the combobox that not exist in the table column. For example I need to add "All" item in the cobmobox so user can select a particular customer name or All. at other place I wan't to add "Other" item in combobox with same rowsource so if the customer is new user can select Other and then type name in textbox.
I tried following code to add an item
Private Sub UserForm_Activate()
With Me.testCombo
.AddItem "All"
End With
End Sub
but i got error
Run-time error '70'
permission denied
if i remove rowsource property from the combobox then the above code work but only one item "All" display.
Note: I don't want to add "All" and "Other" in customer table, this could be easy solution but will cause other problem.
Try like this:
Private Sub UserForm_Activate()
Dim rowValue As Variant
Dim lngCount As Long
Dim myCell As Range
Dim varCombo() As Variant
With Me.ComboBox1
ReDim varCombo(Me.ComboBox1.ListCount)
For Each myCell In Range(.RowSource)
varCombo(lngCount) = myCell.value
lngCount = lngCount + 1
Next myCell
.RowSource = ""
For lngCount = LBound(varCombo) To UBound(varCombo) - 1
.AddItem CStr(varCombo(lngCount))
Next lngCount
.AddItem "All"
.AddItem "Nothing"
End With
End Sub
As mentioned in the comments, by A.S.H., you should unset the .RowSource property. However, you do not lose it, if you run the code twice, it would be the same. In my code I use UBound(varCombo) - 1, because I use lngCount=lngCount+1 on the last looping over the cell.
Something like this could do what you need
Dim a() As Variant
Dim b() As String
Dim s As String
a = Application.Transpose(Range("a1:a5").Value)
s = "Please select;" & Join(a, ";")
Erase a
b = Split(s, ";")
Me.ComboBox1.List = b
Thank you everyone for helping, the main problem was permission as A.S.H said if Rowsource is set then cannot add any item in the ComboBox. So I delete the RowSource from the properties in form. and wrote following code and it seems everything working fine. I hope my codes are good enough and simple.
Private Sub fillComboBox()
Dim comboData As Range
With Me.CWR_CustName
' first option of comobobox will be All
.AddItem "All"
For RW_Cust = 1 To Range("tblCust").Rows.Count
' add each customer name from customer table name column
.AddItem (Range("tblCust[Name]")(RW_Cust))
Next RW_Cust
End With
End Sub
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.
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.
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)