Excel VBA .Find Function changing values in selection - vba

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.

Related

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.

Assigning a combobox a named list in vba

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.

Searching and Returning bold values in VBA

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

Use VLOOKUP to pass cell reference to a public variable?

I have a userform that opens on cell change in a column.
That userform contains checkboxes, which all trigger a second userform with a text box which looks up a cell on a hidden sheet for its contents. (The checkbox that's ticked determines which cell the textbox looks for). The user then edits the box, clicks a button, and the new text is written back to the same cell.
This is the VBA for when the checkbox is ticked. It works great. Hooray!
Dim vln As Variant
Dim reta As Worksheet
Set reta = ActiveWorkbook.Sheets("RetailerActivity")
Set vln = ActiveCell.Offset(-1, -3)
UserForm2.TextBox1.Text = Application.WorksheetFunction.VLookup(vln, reta.Range("A1:Z100"), 3, False)
UserForm2.TescoSave.Visible = True
UserForm2.Show
End Sub
When the textbox has been edited, I would like to write it back to the same cell it came from. I figure the easiest way to do that is to have a public variable (as range), and to pass the result of the vlookup into that variable so the second userform can have a line which reads
Private Sub ASave_Click()
publicvariable.Value = TextBox1.Value
userform1.hide
End Sub
Nice and easy, rather than doing a VLookup again. Right?
Either way, I can't seem to set the public variable as the lookup.
Outside of any sub I have
Public bums As Range
And in the code above, after the bit where I've set the text box, I've tried to add the line
Set bums = Application.WorksheetFunction.VLookup(vln, reta.Range("A1:Z100"), 3, False)
But the code errors with a "type mismatch".
If I try
Set bums = Range(Application.WorksheetFunction.VLookup(vln, reta.Range("A1:Z100"), 3, False))
I get method "Range" of object "_global" failed.
I code by cobbling bits off the internet, as you can probably tell, so this is I don't doubt a complete kludge.
Any advice would be super appreciated.
VLookup returns a value, not a Range. You could use Match to find the row and then Cells to get the actual reference - for example:
Dim vMatch
vMatch = Application.Match(vln, reta.Range("A1:A100"),0)
If Not IsError(vMatch) then
Set bums = reta.Cells(vMatch, "C")
else
msgbox "No match for " & vln
Exit Sub
End If
Personally I would also not use a public variable, but create a property for Userform2 to which you can assign the range.

List Box shows dates that aren't in the range

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.