How to set OFFSET if there is a chance that new columns are added in between - vba

I have a scenario where in based on a button searck(click) I need to update one particular cell with value from search result.
The search button TopLeftCell property and OFFSET() method is used to get to the cell to which the value is copied
With Sheets("Test").Shapes("btnSearch").TopLeftCell
.Offset(0, -4).Value = searchResult
End With
But there is a requirement that if there is any columns that was added to later between these cells then offset will have to be changed back again
Is there any way to handle this case so that we don't have to worry about the OFFSET method even when we add/delete a column in between
Please note that these cells are actually part of a list/grid in excel which are dynamically incremented.

Just tested this and it worked:
With Sheets("Test")
Dim resCol As Long
'change myHeader to defined header and row number as needed
resCol = .Rows(1).Find("myHeader").Column
Dim resRow As Long
resRow = .Shapes("btnSearch").TopLeftCell.Row
.Cells(resRow, resCol).Value = searchResult
End With

Related

Excel VBA Validation List set Default Value

I have worked out the following code (minus the Dim and Set section, but WS1 = Sheet1 and WS2 = Sheet2) that will set all 'Validation List' default values on my target Excel Worksheet to the first item in their referenced Tables:
'+++Work through the processing of the 'Validation Lists' in the Worksheet+++
For Each rngValList In WS1.Cells.SpecialCells(xlCellTypeAllValidation).Cells
With rngValList
If .Validation.Type = xlValidateList Then
'Process those that should be set as the first value in the list.
.Value = Range(Replace(.Validation.Formula1, "=", "")).Cells(1, 1)
End If
End With
Next rngValList
However, there is one Validation List on that same target page where I would like to set the default value to a different item contained in the list. I can do this by just separately calculating the item and then updating the cell where the Validation List values are selected, which works. But, what I'd really like to do is have the list (which is long) focus on the targeted default item, when the drop-down button is selected. Using this method, the first item in the drop-down list is still the focus of the list.
I tried modifying the code above to change the default value (probably in a way too complex change, but it worked), and it does select the correct value. But, the focus in the drop-down list is still on the first item in the list, when it is selected.
My modified code is as follows:
'+++Work through the processing of the 'Validation Lists' in the Worksheet+++
For Each rngValList In WS1.Cells.SpecialCells(xlCellTypeAllValidation).Cells
With rngValList
If .Validation.Type = xlValidateList Then
'If the Valdation List is Month End, then select the correct month date.
If .Validation.Formula1 = "=LUT_MonthEnd" Then
'Set the Default End Month value to the correct Month.
i = 0
For Each rngSMList In WS2.Range(TS).Cells
i = i + 1
With rngSMList
If rngSMList = WS2.Range(DS) Then
'Capture the counter at this point and exit to the rngValList Range Object.
GoTo EndMthStop
End If
End With
Next rngSMList
EndMthStop:
.Value = Range(Replace(.Validation.Formula1, "=", "")).Cells(i, 1)
Else
'Process those that should be set as the first value in the list.
.Value = Range(Replace(.Validation.Formula1, "=", "")).Cells(1, 1)
End If
End If
End With
This is not a big deal, as I am able to set the default value to the correct one, so things work fine as it is. But, it would be nice to have the default value selected be the one in focus when the drop-down list is selected, rather than always the first item in the list.
Conceptually, I guess what I need is a pointer to the correct default value in the target Table List.
Any suggestions on how this can be accomplished would be most appreciated.
Regards,
Wayne
This should get you started, along with my comments above. Paste the following code into the worksheet object (not a module).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
Target.value = "Your Value"
End If
End Sub
The Sub Worksheet_SelectionChangeis an event that fires every time a new cell is selected.
Application.Intersect returns a range that represents the overlap between two ranges.
The example above assumes your list is in cell A1.
Target is the cell that was clicked on, so we set the value of the cell to whatever value you want selected in your list.
select the cell in which you have put the listitem.
the range for the listitem is "Opleiding"
in your VBA code:
selection.Value = Range("opleiding").Cells(2, 1)
the result is that the selected item of the listItem is the second item in the range "Opleiding"

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.

Copy a link if cell value matches entry in another list

There is a column with blocks of file names, and there is a column with keys and values:
I have to assign the link "www.111.com" to all AAAAA.jpg areas, "www.222.com" to BBBBB.jpg areas, etc.
Result:
How can be this done?
I think the following VBA code will help you. It does these steps:
Declare a range ("myRange") and set it to cell A1 (the top cell of your list of .JPGs)
Declare a variant ("hText")
Lookup the value in "myRange" in the lookup table at D:E (change to suit your workbook). Store the value in "hText"
Check if hText is an error (i.e., the value was not found in the lookup table). If it was as error, skip the cell. If it wasn't an error, go to step 5.
Add a hyperlink to the current "myRange" cell. Use the hText as the address, use the text of the current "myRange" cell as the displayed text.
Move "myRange" to the next cell down. Loop steps 3-6 until it reaches an empty cell.
Note that the loop will stop when it reaches an empty cell, so if there is a gap in your list it will not reach the bottom. Also, note that any values that are not found in the lookup table will be skipped (no hyperlink added).
Run this code while the sheet with the list of .JPGs is selected.
Sub AddHyperlinks()
Dim myRange As Range
Set myRange = Range("A1")
Dim hText As Variant
Do Until IsEmpty(myRange)
hText = Application.VLookup(myRange.Value, Worksheets("Sheet1").Range("D:E"), 2, False)
If IsError(hText) Then
hText = ""
Else
ActiveSheet.Hyperlinks.Add Anchor:=myRange, Address:=hText, TextToDisplay:=myRange.Text
hText = ""
End If
Set myRange = myRange.Offset(1, 0)
Loop
End Sub

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

Prevent Range.Find() from changing the "match entire cell content" user interface setting

After running the first line of the following code, Excel changes the Match entire cell contents setting in the user interface. The result is that the next time the user presses Ctrl+F the search is done in the whole cell content. I don't like a VBA macro that changes a setting that affects the user experience, so I always execute the second line, which performs another search and sets the Match entire cell contents back to its default.
'execute the find and changes the entire cell content setting
Set C = MyRange.Find(SomeText, LookAt:=xlWhole)
'put the setting back to the default value (not the previous value)
MyRange.SomeText ParName, LookAt:=xlPart
The problem is that it sets it back to the default, not to the value the user set it last.
I would rather have something like:
'store the current entire cell content setting
OldLookAt = Application.FindLookAt
'execute the find
Set C = MyRange.Find(SomeText, LookAt:=xlWhole)
'restore the original setting
Application.FindLookAt = OldLookAt
I made up the Application.FindLookAt because I wasn't able to find it.
Is there a way to Range.Find something without affecting the user experience?
I spent a fair bit of time looking through the Excel object library and MSDN documentation and it doesn't seem this is possible to retrieve.
Unfortunately it also looks like Excel actually overrides and sets your user setting if you don't include the parameter to the default.
Private Sub testXLLookAT()
'Setup fake falues
Dim mCurLookup As XlLookAt
Range("A1").value = "Test1"
Range("A2").value = "Test"
'get current setting, but this doesn't work as it defaults...
If Range("A1:A2").Find("Test").Address = "A1" Then
mCurLookup = xlPart
Else
mCurLookup = xlWhole
End If
'your find here
'note - mCurLookup always becomes xlWhole...
Range("A1:A2").Find What:="Test", LookAt:=mCurLookup
End Sub
Otherwise, the above code would work - but it doesn't as the default gets overwritten even when it's not included.
Here's a function that can be used to return the current LookAt default value so it may be reset.
Function lGetCurLookAt() As Long
'--returns current default value for Range.Find method's
' LookAt parameter.
'--use helper cell after all data in col A
With Cells(Rows.Count, "A").End(xlUp)(3)
.Value = "TestPart"
lGetCurLookAt = IIf( _
.Find(What:="Part", SearchFormat:=False) Is Nothing, _
xlWhole, xlPart)
.Value = vbNullString
End With
End Function
My first post, so I'm not able to add comment to enderland's answer. In spirit of being helpful, that code didn't work as expected because it used A1 instead of $A$1.