Hope you can help me.
I want to copy and paste a cells value based on when you click a hyperlink on that cell.
So for example, I have a sheet called Form1, I want to click on an ID in column A it will then copy the value of that cell and paste it to B2 in sheet1 and then take me to sheet 1.
Currently I have a macro that allows me to click on an active cell and then press a button which then does what is mentioned above. I just think a hyperlink press would be more user friendly and would result in less errors.
Here is the code I have at the moment:
Sub Rectangle13_Click()
ActiveCell.Copy Destination:=Sheets(“Sheet1”).range(“B2”)
Worksheets(“Sheet1”).Activate
End Sub
Any help would be appreciated! Thank you
Worksheet FollowHyperLink
Copy this code to the sheet module of worksheet Form1. From there, run the second sub to convert the A column to hyperlinks.
Click away.
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Not Intersect(Columns("A"), Target.Range) Is Nothing Then
Me.Parent.Worksheets("Sheet1").Range("B2").Value = Target.Range.Value
End If
End Sub
' Run this to create hyperlinks out of the values in column 'A'
' which will point to cell 'B2' in 'Sheet1'. You can then reformat
' the cells (remove underline, change font color, ...).
Private Sub CreateHyperlinks()
Dim lRow As Long: lRow = Range("A" & Rows.Count).End(xlUp).Row
Dim cell As Range
For Each cell In Range("A2:A" & lRow).Cells
cell.Hyperlinks.Add cell, "", "Sheet1!B2", , CStr(cell.Value)
Next cell
End Sub
It is inconvenient to use Hyperlik, I think. If you try changing the cell value, you cannot simple click it and write something... But if you want that, you can create such a hyperlink in the next way:
Sub testAddHyperlink()
Dim DestSh As Worksheet
Set DestSh = Sheets("Sheet1") 'you can use any sheet name here
ActiveSheet.Hyperlinks.Add Range("A1"), Address:="", SubAddress:="'" & DestSh.name & "'" & "!A1"
'it will keep the existing cell value
End Sub
Then, please copy the next event code in the sheet code module (where the hyperlink exists):
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim rngCopy As Range, shDest As Worksheet
Set shDest = Sheets("Sheet1") 'you may use here any sheet name
shDest.Range("B2").value = Target.Parent.Value 'the sheet where the hyperlink targets, is already activated...
End Sub
If you want to use the BeforeDoubleClick approach, paste this code into your Form1 worksheet object in the VBA editor ...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count = 1 And Target.Cells(1, 1).Column = 1 Then
Cancel = True
With ThisWorkbook.Worksheets("Sheet1")
.Range("B2") = Target.Value
.Activate
End With
End If
End Sub
... naturally, this is a base example and you may need to modify it accordingly. For example, when you double click, you may want to ignore the first row if it's a header and not invoke the core parts of the logic.
That will then do what you want.
Related
After clicking a hyperlink and arriving at a target cell, I would like to select (highlight) the entire row of the target cell and scroll left if it's too far right so that the target cell is around the middle column of the screen and about 5 columns to its right can be seen. I used FollowHyperlink() after looking through similar posts in stackoverflow. However, the code has no error but does not do anything.. How can I rewrite the code to address the issue?
Sub CreateHyperlink()
...
If i > 1 Then
.Hyperlinks.Add ...
End If
End Sub
Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
ActiveWindow.ScrollColumn = Target.Column
Target.EntireRow.Select
End Sub
I think this is what you want?
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim ws As Worksheet
Dim rng As Range
'~~> Get the name of the worksheet
Set ws = ThisWorkbook.Sheets(Split(Target.SubAddress, "!")(0))
With ws
'~~> Get the range
Set rng = .Range(Split(Target.SubAddress, "!")(1))
'~~> Unhide it, in case it is hidden
.Visible = xlSheetVisible
'~~> Go To that cell
Application.Goto rng, Scroll:=True
'~~> Select the row and activate it so that it comes in the center
rng.EntireRow.Select
rng.Activate
End With
End Sub
My assumptions
The target range is a single cell in the same workbook. If you still want to scroll 5 columns more then you can use ActiveWindow.SmallScroll ToRight:=-5. Amend it as per your requirement.
Note: This code Worksheet_FollowHyperlink goes in the sheet code area.
I have Sheet1 and Sheet2. In Sheet1 I have a table with a column of hyperlinks that redirect to defined cells in Sheet2. What I'd like to do is to have automatically selected the entire row of the cell in Sheet2 that I've been redirected to.
I have tried this in Sheet2 code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.EntireRow.Select
End Sub
Which selects the entire row for a given selected cell. However this is not very comfortable as it's a permanent selection and, let's say, when I want to select a column it selects the whole sheet. What is a better way of doing this?
I think it is important to mention that I don't want to change the format of the rows in order to highlight them, I only want to select them.
The issue is that Target.EntireRow.Select triggers another Worksheet_SelectionChange event. You need to prevent that with Application.EnableEvents = False:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Target.EntireRow.Select
Application.EnableEvents = True
End Sub
But maybe you could use the Worksheet_FollowHyperlink which could be a better choice.
Best approach would be to change the hyperlink to point to the whole row instead of a single cell. So instead of pointing to A5 point the hyperlink to 5:5 no VBA needed then.
FollowHyperlink
Highlights
In the FollowHyperlink event, Target is a Hyperlink object.
If the Address property and the SubAddress property of a Hyperlink object are different than "", it will point to a location in another workbook.
If the Address property of a Hyperlink object is "", then it will point to a location in this workbook.
If additionally the SubAddress property does not contain an exclamation mark !, it could point to a defined name.
If the SubAddress property does contain an exclamation mark !, it will contain single quotes ' when the sheet name contains spaces.
The Code
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Const cSheet As Variant = "Sheet2" ' Target Worksheet Name/Index
Dim i As Integer ' Names Counter
Dim strRng As String ' Target Range Address Builder
Dim strSheet As String ' Target Worksheet Name Builder
' Check if hyperlink points to a location outside this workbook.
If Target.Address <> "" Then Exit Sub
' Assign the value of Target.SubAddress to Target Range Address Builder.
strRng = Target.SubAddress
With ThisWorkbook ' Me.Parent
' Check if hyperlink points to a named range ("!").
If InStr(strRng, "!") = 0 Then
' Loop through all names.
For i = 1 To .Names.Count
' Compare their NAME to Target Range Address Builder.
If .Names(i).Name = strRng Then
strRng = Right(.Names(i).RefersTo, Len(.Names(i).RefersTo) _
- 1) ' Remove "=".
Exit For
End If
Next
If i > .Names.Count Then Exit Sub ' Name not found.
End If
' Calculate worksheet name.
strSheet = Replace(Left(strRng, InStr(strRng, "!") - 1), "'", "")
' Check if calculated worksheet name is equal to Target Worksheet Name.
If strSheet <> .Worksheets(cSheet).Name Then Exit Sub
' Calculate the Target Range Address.
strRng = Right(strRng, Len(strRng) - InStr(strRng, "!"))
' Select the entire row of Target Range.
.Worksheets(strSheet).Range(strRng).EntireRow.Select
End With
End Sub
Why doesn't the following code always work?
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
ActiveCell.EntireRow.Select
End Sub
My sheet has data in columns A to Z. I have hyperlinks in rows 13 to 49 that jump to specific cells in rows below. For example, the hyperlink in row 13 will jump to row 229.
The hyperlinks are fine until I do a presentation on another machine with a different resolution. Instead of jumping to row 229, it shows row 248.
I have tinkered with this and this but have had no success yet. Also tried this less related answer to see if I can trick excel. I have also tried the below code:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
r = ActiveCell.Row
Range(Cells(r, 1), Cells(r, 26)).Select
'Target.Range.Select
ActiveWindow.Zoom = True
If you are looking to put A229 into the top-left corner of the visible worksheet area, then fool Excel by first going past the visible portion of the worksheet that you want and come back to it.
In A13, put a hyperlink that goes to A1229, not A229.
Sub setup_Hyperlinks()
With Worksheets("Sheet1")
With .Range("A13")
.Hyperlinks.Delete
.Hyperlinks.Add Anchor:=.Cells(1), Address:="", SubAddress:="Sheet1!A1229", _
ScreenTip:="Jump to row 229", TextToDisplay:="Row 229"
End With
End With
End Sub
Note that the actual subaddress target is A1229, not A229.
Right-click the worksheet's name tab and choose View Code. When the VBE opens, paste one of the following into the worksheet code sheet titled something like Book1 - Sheet1 (Code).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells(1, 1).Row > 1000 Then 'this will depend on how you craft the method for your own purposes
Application.Goto _
Reference:=Target.Cells(1, 1).Offset(-1000, 0)
'[optional] move one row down for personal aesthetics
'ActiveWindow.SmallScroll Down:=-1
End If
End Sub
... or,
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If ActiveCell.Row > 1000 Then 'this will depend on how you craft the method for your own purposes
Application.Goto _
Reference:=ActiveCell.Offset(-1000, 0)
'[optional] move one row down for personal aesthetics
'ActiveWindow.SmallScroll Down:=-1
End If
End Sub
Use one or the other but not both. The former seems to have marginally less screen 'flash' on my system.
It just hit me. Check out Windows(1).VisibleRange.Rows.count
You can see how many rows are displayed, go down so the link target will be at the top. This should be accurate regardless of the resolution.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim iActive As Integer
Dim lBottom As Long
Dim ws As Excel.Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
'Get the number of rows showing
iActive = Windows(1).VisibleRange.Rows.count
'Move to center of the active window
lBottom = ActiveCell.Row + (iActive / 2) - 1
ws.Range("A" & lBottom).Activate
End Sub
I have an issue which i can't solve.I wrote this code:
Private Sub CommandButton2_Click()
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Sheets("sheet3").Range("V7").PasteSpecial
End Sub
This code copy a checkbox from (sheet 2) to (sheet 3) starting from V7 cell. Now I want the next time I press the command button to paste the data to cell V12,next time to V17 etc. My vba knowledge is not very good as you can see.
This code will see how many checkboxes are already in the sheet you are pasting to and add 5 rows for each check box, then paste five rows under the last one.
Private Sub CommandButton2_Click()
' copy checkbox
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Dim wks As Worksheet
Set wks = Sheets("Sheet3")
Dim cb As OLEObject, i As Integer
'determine how many boxes are already there and get count of cell to paste to
i = 7
For Each cb In wks.OLEObjects
If InStr(1, cb.Name, "CheckBox") Then i = i + 5
Next
'paste new checkbox
Sheets("sheet3").Range("V" & i).PasteSpecial
End Sub
Use a global variable. These must be at the top of your sheet, module, or form code above all subs and functions.
Then use that as the row number in your range. Range("V" & lRow)
Private lRow As Long
Private Sub CommandButton2_Click()
'Let's check if this is the first time the button has been used.
If lRow = 0 then
lRow = 7
Else
'Increment the row from the one we wrote to last time.
lRow = lRow + 5
End If
'Do the copy
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Sheets("sheet3").Range("V" & lRow).PasteSpecial
End Sub
I dont know what data you got between in Sheet(3).Range("V7") and Sheet(3).Range("V12")
but juste before you're PasteSpecial, you shoud keep track where was the last time you paste data in Sheets("sheets3") in a specific cell in Sheet("sheets3"), in exemple : Sheets("Sheet3").Range("A1")
Then you'll be able to pastespecial to this cell 5 row under like this :
Sheets("sheet3").Range(Sheets("Sheets3").Range("A1").Offset(5,0)).PasteSpecial
right after that you update the Sheets("Sheets3").Range("A1") = Sheets("sheet3").Range(Sheets("Sheets3").Range("A1").Offset(5,0)).Address
So this should do the work :
Private Sub CommandButton2_Click()
Dim oWsSource as Worksheet
Dim oWsDestination as Worksheet
Set oWsDestination = ThisWorkbook.Worksheet("Sheets3")
Set oWsSource = ThisWorkbook.Worksheet("Sheets2")
'Do the copy
oWsSource.OLEObjects("CheckBox1").Copy
oWsDestination.Range(oWsDestination.Range("A1").Value).Offset(5,0)).PasteSpecial
oWsDestination.Range("A1").Value = oWsDestination.Range(oWsDestination.Range("A1").Value).Offset(5, 0)).Address
End Sub
All the answers put the first checkbox but the next one put it again to the same cell as before.I don't know if its matter but I use excel 2010.
I have an excel workbook that contains multiple sheets within it. For the sake of this question, the sheets are named Sheet1, Sheet2, Sheet3, and so on. I would like to have Column A from sheet1 be replicated throughout the rest of the sheets and as new cells are added to column A in sheet1, they would automatically be entered into the other sheets within the workbook. I would prefer not to have a set "ending range; ie: A100000" for this. For example, if I enter First in cell A1 of Sheet1, the word "First" should now also appear in cell A1 of Sheet2. I have used the following code, and it does not seem to work. Any help would be greatly appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Call UpdateFromSheet1
End Sub
Sub UpdateFromSheet1(ByVal Sh As Object, ByVal Target As Range)
If Sh.CodeName = "Sheet1" Then
If Not Intersect(Target(1, 1), Range("A1:A1000")) Is Nothing Then
Sh.Range("A1:A1000").Copy Sheet2.Range("A1")
End If
End If
End Sub
UPDATE
For a clean looking Non-VBA solution, you can use the formula references that others have mentioned, but enter it like this.
In Sheet2 cell A1 = If(Sheet1!A1="","",Sheet1!A1) That way you can fill down on the whole of column A and not have "0" pop-up if Sheet1 has a rows without data.
I think you have the general idea, but I suspect you may not have your code in the right place.
For the VBA solution:
First, you don't need to call the sub from Worksheet_Change event (unless of course you want to use this sub for other reasons and pass variables to it. Second, if you place this code in the worksheet object in the VBE of the "Sheet1" it will do as you wish:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("A")) Is Nothing Then
Dim wks As Worksheet
For Each wks In Sheets(Array("Sheet2", "Sheet3"))
Target.EntireColumn.Copy wks.Columns(1)
Next
End If
End Sub
This is a very basic use for excel. You can set cells equal to each other. You in no way would need a VBA macro for this.
If you put this in cell "A1" on Sheet2 and Sheet3:
=Sheet1!A1
Then when you type something into A1, it will be "mirrored" on sheets 2 and 3. You can autofill this down to all the cells in column A on sheets 2 and 3.
Are you familiar with the term autofill?
If you don't understand anything I just said and you want to just run a macro then run this and start typing away:
Sub MacroBasicQuestion()
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = wbk.Sheets(1)
Set ws2 = wbk.Sheets(2)
Set ws3 = wbk.Sheets(3)
Dim cell As Range
Set cell = ws2.Range("A1:A1")
ws2.Select
cell.FormulaR1C1 = "=Sheet1!RC"
cell.Select
Selection.AutoFill Destination:=Range("A:A"), Type:=xlFillDefault
Set cell = ws3.Range("A1:A1")
ws3.Select
cell.FormulaR1C1 = "=Sheet1!RC"
cell.Select
Selection.AutoFill Destination:=Range("A:A"), Type:=xlFillDefault
End Sub
Good Luck.