Excel VBA: How to autocreate hyperlink from cell value? - vba

I have a table called Table1
In Column B, I have the ticket number. e.g: 76537434
Requirement: when any change happens in any cell in column B, that cell (Target cell) to be changed into a hyperlink such that the hyperlink address would be example.com/id=76537434
Cell value i.e. 76537434 must remain the same

Add this event handler to your worksheet's code module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Target.Hyperlinks.Delete ' or Target.ClearHyperlinks to conserve the formatting
Me.Hyperlinks.Add Target, "http://example.com/id=" & Target.value
End Sub

The following Worksheet_Change event should be able to solve your problem:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim tmp As String
If Intersect(Range("B:B"), Target) Is Nothing Then Exit Sub
For Each cell In Target
If cell.Column = 2 Then
Application.EnableEvents = False
tmp = cell.Value2
cell.Parent.Hyperlinks.Add _
Anchor:=Cells(cell.Row, 2), _
Address:="http://example.com/id=" & tmp, _
TextToDisplay:=tmp
Application.EnableEvents = True
End If
Next cell
End Sub
Note, that you must copy it to the sheet and not into a separate module.

=HYPERLINK(E14&F14,"Name")
where cell E14 contains "http://www.example.com/id=" and cell F14 contains "76537434".
This soultions doesn't need VBA macros.

Related

Update a cell value with Row and Column number for use in indirect function based on which cell is selected

Hi I have a spreadsheet similar to below
Where when I click on a cell (red cell), I want to return the row and column number to another cell for use in an indirect lookup (blue cell)
Ideally I want to only update the cell value if it's within a set range or at least limit it only to that worksheet for error handling.
Hope that's clear... not an easy thing to google. My experiments with
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
MsgBox ActiveCell.Row
End Sub
Have returned nothing, not even a message box even though macros run fine. Any ideas?
Based on your example. Make sure your code is in the appropriate sheet module, not a standard module and make sure Application.EnableEvents=True (your existing code should have done something).
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Intersect(Target(1), Range("C4:H9")) Is Nothing Then Exit Sub
Range("J3").Value = Cells(Target(1).Row, 2) & "," & Cells(3, Target(1).Column)
End Sub
Use this in the worksheet's private code sheet.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target.Cells(1), Range("C4:H9")) Is Nothing Then
Range("C4:H9").Interior.Pattern = xlNone
Cells(3, "J") = Join(Array(Cells(Target.Cells(1).Row, "B"), _
Cells(3, Target.Cells(1).Column)), Chr(44))
Target.Cells(1).Interior.ColorIndex = 3
End If
End Sub

VBA: How to automatically trigger macro without a button

I have made a macro that auto fill the formula on sheet1 whenever the row number of sheet2 is changed.
Is it possible to trigger it automatically without a button when i have any update on sheet2?
Sub Autofill()
Dim sg As Sheets
Dim Row As Long
Dim fillRow As Integer
Application.EnableEvents = False
Row = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
fillRow = Row - 1
Sheets("Sheet1").Select
Range("A1:E1").Select
Selection.Autofill Destination:=Range("A1:E" & fillRow), Type:=xlFillDefault
Application.EnableEvents = True
End Sub
You could try to create a sub like following:
Paste the following code. And change:
1) "D4" with your cells you want to "monitor"
2) Paste your macro in the line "Do things"
The problem is, your code is run everytime the focus is changed to another cell.
But you could also use Worksheet_BeforeDoubleclick if this is enough. Then every time you clicke twice the code will run
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("D4")) Is Nothing Then
'Do things
End If
End If
End Sub
Right-click on the sheet tab at the bottom of the scree, click 'view
code' then insert this following code in there.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Row As Long
Dim fillRow As Integer
This next line will exit the code if column A is not what is being
changed on the sheet. Delete it if you want the code to be triggered
by any change on any cell of the sheet.
if InRange(Target,Worksheets("Sheet2").range("A:A") = false then exit sub
Row = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
fillRow = Row - 1
Sheets("Sheet1").Select
Range("A1:E1").Select
Selection.Autofill Destination:=Range("A1:E" & fillRow), Type:=xlFillDefault
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
use a Worksheet.SelectionChange-Event.
in the Worksheet-VBA for sheet2 add:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Autofill()
End Sub
(This will be triggered if cell is changed, even if user does not leave the row, so check parameter Target.)

Dynamically renaming excel sheets

From a previous question, to dynamically rename a sheet based on a cell reference changing, you use this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "C3" Then ActiveSheet.name =
ActiveSheet.Range("C3")
End Sub
But this does not work if the cell ("C3") is in sheet 1 but is itself referencing a cell on another sheet - let's say C3 is referencing "A1" in "sheet 2".
How can you change the code so when you edit A1 in sheet 2, the name of sheet 1 automatically updates?
Thanks!
Add the code below in the Worksheet_Change event in "Sheet2" worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
' only run the code if the cell being modified is in cell "A1"
If Not Intersect(Range("A1"), Target) Is Nothing Then
Worksheets("Sheet1").Name = Target.Value
End If
End Sub
Or place this code on Sheet1 Module...
Private Sub Worksheet_Calculate()
On Error Resume Next
Sheet1.Name = Range("C3").Value
End Sub
Note: Sheet1 here is the Sheet Code Name.
So each time the value of A1 changes on Sheet2, the Sheet1 will be renamed.

Excel VBA - Run a macro when a cell is changed

I am trying to write a macro that runs automatically any time a sheet is edited. Column H has the heading "Updated on" and the macro should put today's date in cell H# where # is the row of the cell that was changed. Here's the code I used:
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Select
Range("H" & ActiveCell.Row).Select
ActiveCell.Value = Date
End Sub
After saving the workbook and changing the value of cell A2, the code put today's date into H2 as I expected, but then gave me an error. I clicked debug, and the Target.Select line was highlighted. I assumed that looping was the problem, so I updated the code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target.Select
Range("H" & ActiveCell.Row).Select
ActiveCell.Value = Date
Application.EnableEvents = True
End Sub
This time, I changed the value of cell B3, and it put today's date into B4. Then Excel partially froze: I could still edit that workbook, but I couldn't open or view any other workbook. I closed all the workbooks, but then Excel itself would not close and I had to use the Task Manager to end it.
Using
Private Sub Worksheet_Change(ByVal Target As Range)
Range("H" & Target.Row).Value = Date
End Sub
will give you better stability. Target is the range that's changed.
It's just possible (I'm at home so can't check) that changing the value re-fires the Worksheet_Change event. If so, then block the recursion with
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> Range("H" & Target.Row).Address Then
Range("H" & Target.Row).Value = Date
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
const DATE_COL as long = 8
Dim c as range
Set c = Target.Cells(1)
If c.Column = DATE_COL Then Exit Sub
On Error Goto haveError
Application.EnableEvents=False
Me.Cells(c.Row, DATE_COL).Value = Date
haveError:
Application.EnableEvents=True
End Sub

VBA trigger macro on cell value change

This should be simple. When the value of a cell changes I want to trigger some VBA code. The cell (D3) is a calculation from two other cells =B3*C3. I have attempted 2 approaches:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row = 3 Then
MsgBox "There was a change in cell D3"
End If
End Sub
Since the cell is a calculation this is not triggered when the value changes, because the calculation remains the same. I also tried:
Private Sub Worksheet_Calculate()
MsgBox "There was a calculation"
End Sub
But I have multiple calculations on the sheet and it triggers multiple times. Is there a way I can identify which calculation changed on the calculation event? Or is there another way I can track when D3 changes?
Could you try something like this? Change the formula to =D3AlertOnChange(B3*C3).
Private D3OldVal As Variant
Public Function D3AlertOnChange(val)
If val <> D3OldVal Then MsgBox "Value changed!"
D3OldVal = val
D3AlertOnChange = val
End Function
Or try
Private Sub Worksheet_Change(ByVal Target As Range)
Dim numdependences As Integer
On Error Resume Next
HasDependents = Target.Dependents.Count
If Err = 0 Then
If InStr(Target.Dependents.Address, "$D$3") <> 0 Then
MsgBox "change"
End If
End If
On Error GoTo 0
End Sub
You need the error control in case you change a cell that has not dependents.
try this:
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B1")) Is Nothing Then
Call macro
End If
End Sub
looks for a change in value of cell B1, then executes "macro"
If you are only looking at if the Worksheet_Change then it will count a change for anything entered even if it is the same as the previous value. To overcome this I use a Public variable to capture the starting value and compare it.
This is my code to do this. It also allows you omit parts of the worksheet or you can use it to evaluate every cell in the worksheet.
Place this code in the Worksheet.
Public TargetVal As String 'This is the value of a cell when it is selected
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then 'If more then one cell is selected do not save TargetVal. CountLarge is used to protect from overflow if all cells are selected.
GoTo EXITNOW
Else
TargetVal = Target 'This sets the value of the TargetVal variable when a cell is selected
End If
EXITNOW:
End Sub
Sub Worksheet_Change(ByVal Target As Range)
'When a cell is modified this will evaluate if the value in the cell value has changed.
'For example if a cell is entered and enter is pressed the value is still evaluated
'We don't want to count it as a change if the value hasn't actually changed
Dim ColumnNumber As Integer
Dim RowNumber As Integer
Dim ColumnLetter As String
'---------------------
'GET CURRENT CELL INFO
'---------------------
ColumnNumber = Target.Column
RowNumber = Target.Row
ColumnLetter = Split(Target.Address, "$")(1)
'---------------------
'DEFINE NO ACTION PARAMETERS
' IF CELL CHANGED IS IN NO ACTION RANGE, EXIT CODE NOW FOR PERFORMANCE IMPROVEMENT OR TO NOT TAKE ACTION
'---------------------
If ColumnNumber <> 4 Then 'This would exempt anything not in Column 4
GoTo EXITNOW
ElseIf RowNumber <> 3 Then 'This would exempt anything not in Row 3
GoTo EXITNOW
'Add Attional ElseIf statements as needed
'ElseIf ColumnNumber > 25 Then
'GoTo EXITNOW
End If
'---------------------
'EVALUATE IF CELL VALUE HAS CHANGED
'---------------------
Debug.Print "---------------------------------------------------------"
Debug.Print "Cell: " & ColumnLetter & RowNumber & " Starting Value: " & TargetVal & " | New Value: " & Target
If Target = TargetVal Then
Debug.Print " No Change"
'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF NOT CHANGED
Else
Debug.Print " Cell Value has Changed"
'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF CHANGED
End If
Debug.Print "---------------------------------------------------------"
EXITNOW:
End Sub