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
Related
I have an Excel Sheet that I am using to track the status of hiring, where each row is a vacancy's record and one of the cells is a drop down list to change the status of that specific vacancy. Statuses are for example (Advertising, Interviewing, Hired)
What I wanted to do is once I click a status, by the end of the row (let's say last of my record here is Column S, so when I click advertising, a date stamp goes on S and the status itself gets printed there on Column T, and if I choose the 2nd status, it would go on Columns U & V and so on.
What I used so far is something different, that reflects the date stamp based on the corresponding column of that status:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Long
Set WorkRng = Intersect(Application.ActiveSheet.Range("H:H"), Target)
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
Select Case Rng.Value2
Case "Not-initiated"
xOffsetColumn = 100 'Column O
Case "Adv/Sourcing"
xOffsetColumn = 9 'Column U
Case "Interviewing"
xOffsetColumn = 10 'Column Q
Case "Offering & Selection"
xOffsetColumn = 11 'Column R
Case "Onboarding"
xOffsetColumn = 12 'Column S
Case "Contract Signed"
xOffsetColumn = 13 'Column U
Case "Joined"
xOffsetColumn = 14 'Column Q
Case Else
xOffsetColumn = 101 'Column T - entry not listed above
End Select
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Next
Application.EnableEvents = True
End If
End Sub
If I understand properly, you want a Drop Down on each row, around column R, with 3 choices, that when selected will populate the cell 1, 2, or 3 cells to the right, with the current date.
What I would do is this: if I'm going to place a Drop Down on top of cell R2, then size it to be exactly the same as the cell* (see bottom of this answer) and hide the Cell Link right underneath it, $R2.
Assign a macro, pointing to this sub in a module:
Sub DropDown2_Change() '(all the drop downs call this sub, on change)
Dim dd As Shape, ddCell As String, ddValue As String, ddIndex As Integer
Set dd = ActiveSheet.Shapes(Application.Caller) 'shape object: the selected DropDown
ddValue = dd.ControlFormat.List(dd.ControlFormat.ListIndex) 'dropdown's new string value [not used]
ddCell = dd.ControlFormat.LinkedCell 'range object: the cell linked to the dropdown
ddIndex = ActiveSheet.Range(ddCell) 'selected index: 1=Advertised,2=Interviewed,3=Hired
Range(ddCell).Offset(0, ddIndex) = Date 'set date of cell 1,2,or 3 cells to the right
End Sub
Sometimes it can be a pain just getting the Drop Downs to line up with the cells properly (especially if you start moving around columns afterwards) but in the past I found it best to create & setup the Drop Downs programmatically, to ensure perfect alignment, correct naming, etc. (In fact, any time I do need to move them after that, I just delete and re-create them ALL, to save a headache.)
Depending on your needs you might be able to get away with copying the 1st completed, functioning Drop Down manually, and pasting it one by one into each cell below. Just make sure that the Cell Link is Abs/Rel like **$**B2 or else they all might default to the same Cell Link.
It's okay if they all share the same sub since the code above will check for the Cell Link of the changed Drop Down.
This way you won't have to mess around with WorkSheet_Change (which doesn't fire for Drop Down changes anyway).
You can download the test sheet I used from JumpShare here: tmpDropDowns.xlsm. (It views online but VBA won't work unless you download it.)
Let me know if you have any questions!
UPDATE:
To populate first empty cell to the right of the Drop Down with the Date + Status (as opposed to populating only columns S,T,U).
Updated Code:
Option Explicit
Sub DropDown2_Change() '(all the drop downs call this sub, on change)
Dim dd As Shape, ddCell As String, ddValue As String, ddIndex As Integer
Set dd = ActiveSheet.Shapes(Application.Caller) 'shape object: the selected DropDown
ddValue = dd.ControlFormat.List(dd.ControlFormat.ListIndex) 'dropdown's new string value
ddCell = dd.ControlFormat.LinkedCell 'range object: the cell linked to the dropdown
ddIndex = ActiveSheet.Range(ddCell) 'selected index: 1=Advertised,2=Interviewed,3=Hired [not used]
FirstEmptyCellToRight(Range(ddCell)) = ddValue & " " & Date 'set date of cell 1,2,or 3 cells to the right
End Sub
Function FirstEmptyCellToRight(cell_In As Range) As Range
'since ".End(xlToRight).Offset(0, 1)" wasn't working for me
'returns cell_In if it's blank, and if not then the first blank cell to the right
Set FirstEmptyCellToRight = cell_In
Do Until IsEmpty(FirstEmptyCellToRight) Or FirstEmptyCellToRight.Value = ""
Set FirstEmptyCellToRight = FirstEmptyCellToRight.Offset(0, 1)
Loop
End Function
Adding screenshot:
Updated File on JumpShare: tmpDropDowns.xlsm
(Must be downloaded; viewing online won't work with VBA.)
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"
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.
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 have a workbook with 2 sheets. First sheet contains table with data to copy, the second sheet contains strings inside which i would like to insert copped data.
The problem is that i don't know how exactly to define 2nd sheet strings a text start/end position, where i would like to paste?
For example:
on a first sheet i have in range A1:A4
<Tracciato xmlns="http://">
<Riquest>
<Test>
<Code></Code>
Then i take from a second sheet B2 cell a value 293 and insert it between , so i get:
<Tracciato xmlns="http://">
<Riquest>
<Test>
<Code>293</Code>
The code could be something like:
Sub Data()
Sheets("First_sheet").Select
Sheets.("First_sheet").Range("B2").Copy Destination:=Sheets("Second_sheet")
End Sub
Here is a brief example:
Sub foo()
Dim copyRange as Range
Dim destRange as Range
Dim copyString as String
'Define the cell from which you want to "copy" the text
Set copyRange = Sheets("First_Sheet").Range("B2")
'Define the destination:
Set destRange = Sheets("Second_Sheet").Range("B2")
'Assign the value from a cell to this string variable
copyString = copyRange.Value
'Now insert the text:
destRange.Value = Left(destRange, 6) & copyString & Right(destRange, 7)
End Sub
Of course, practically speaking you will most likely need to implement this in some sort of Loop structure. YOu may need to use some logic to determine where the destination is, if that is not a 1:1 relationship (i.e., B2 on Sheet1 --> B2 on Sheet2, etc.). You may also need to use some logic to better define the start/end for where to insert. Right now the example code ONLY is for inserting values to a node like <Code></Code>.