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
Related
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.
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 an Excel workbook with a table of contents tab that has hyperlinks to other tabs and different locations on those tabs i.e. names and regions.
My question is, how can I get it to where no matter what hyperlink I click on, it will go to that tab and the cell will always appear in the upper left corner instead of the lower right. Excel by default makes the target cell upper left in the active window, but this is not the case when the target cell is in the active window.
I am trying to make it easier for the end user so they will not have to keep scrolling to that section to get it in view. Thank you in advance.
Slight Addition to: Excel-Hyperlink-Jump-to-cell-and-scroll-window
Place this code in your Table of Contents sheet. Any Hyperlink on your ToC sheet will go to the tab, and scroll to the row and column of the hyperlinks destination.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
ActiveWindow.ScrollRow = ActiveCell.Row
ActiveWindow.ScrollColumn = ActiveCell.Column
End Sub
When the user clicks a link and it sends them to a sheet, the cell that is linked to becomes the ActiveCell. If you include this in every cell that will be linked to, it will auto-scroll to the desired cell when the link is clicked.
Private Sub Worksheet_Activate()
Application.Goto ActiveCell, True
End Sub
The only caveat would be that for occasions where a user might instead click on a cell manually with no intention of scrolling to that cell, it will do so next time the sheet is activated
If you understand how to use VBA with events, this should do what you want.
It includes a defense against sheets with spaces in them.
Sub JumpToPostion()
Dim WS As Worksheet, CellAddress As String
Set WS = Sheet2
CellAddress = "z100"
Application.Goto Range(FixSheet(WS.Name) & "!" & CellAddress), Scroll:=True
End Sub
Private Function FixSheet(txt As String) As String
If InStr(1, txt, " ") > 0 Then
FixSheet = "'" & txt & "'"
Else
FixSheet = txt
End If
End Function
If you put this in the sheet activate event R40 will be the top left cell so perhaps you can work with that?
Private Sub Worksheet_Activate()
Application.Goto Range("R40"), True
End Sub
To take a stage further, this would work if your hyperlinked cells all contained sheet name ! cell address , e.g. Sheet2!R40. The code goes in the sheet module.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim v
v = Split(Replace(Target.SubAddress, "'", ""), "!")
Application.Goto Sheets(v(0)).Range(v(1)), True
End Sub
Insert -> Add HyperLink -> Same document (you can specified any cell)
If you mean Anchor in WorkSheet :-)
I needed a dynamic frozen header row in Excel as the sheet I was working with had Several Tables that were large and were easier to understand if they were located on the same sheet.
But after searching endlessly I could not find a solution as there is no event for scrolling and scrolling doesn't change the active cell.
Thankfully I figured out a work around.
I was able to come up with an acceptable solution for my dilemma after searching for how to Identify the first visible row in the active window running across
MSDN: Identify First Visible Row of Active Window
I was then able to take that code and convert it to a function that could be used in combination with a Timer event that is only activated on the sheet I need the frozen row.
Sheet Code:
Private Sub Worksheet_Activate()
StartFreezePaneTimeRefresh
End Sub
Private Sub Worksheet_Deactivate()
StopFreezePaneTimeRefresh
End Sub
Dynamic Freeze Pane Module Code:
Private RefreshTime
Sub SetFreezePane()
'Check if correct worksheet is active
If ActiveWorkbook.ActiveSheet.Name = "Data" Then
If IdentifyTopVisibleRow < 227 Then
'Check if Frozen Row is the same as the Range to be Copied
If Range("A1") <> Range("AN1") Then
'Copy New Headers for Frozen Row
Range("AN1:BU1").Copy
Range("A1").PasteSpecial xlPasteValues
End If
ElseIf IdentifyTopVisibleRow > 227 Then
'Check if Frozen Row is the same as the Range to be Copied
If Range("A1") <> Range("AN2") Then
'Copy New Headers for Frozen Row
Range("AN2:BU2").Copy
Range("A1").PasteSpecial xlPasteValues
End If
End If
Else
StopFreezePaneTimeRefresh
End If
End Sub
Sub StartFreezePaneTimeRefresh()
Call SetFreezePane
RefreshTime = Now + TimeValue("00:00:01")
Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh"
End Sub
Sub StopFreezePaneTimeRefresh()
On Error Resume Next
Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh", , False
End Sub
Public Function IdentifyTopVisibleRow() As Long
'This code was found on MSDN at
'https://social.msdn.microsoft.com/Forums/en-US/a6cff632-e123-4190-8556-d9f48af8fe9a/identify-first-visible-row-of-scrolled-excel-worksheet?forum=isvvba
Dim lngTopRow As Long ' top row
Dim lngNumRows As Long ' number of visible rows
Dim lngLeftCol As Long ' leftmost column
Dim lngNumCols As Long ' number of visible columns
With ActiveWindow.VisibleRange
lngTopRow = .Row
lngNumRows = .Rows.Count
lngLeftCol = .Column
lngNumCols = .Columns.Count
End With
IdentifyTopVisibleRow = lngTopRow
End Function
The code works by first checking if the correct sheet is active and if it is then it checks the top most visible row every second.
If the top row is Greater or Lesser than the beginning rows of each table it then will check to see if the first header is already set to prevent it from changing the values over and over.
If not it changes the Frozen Row values based upon the users location in the workbook.
Notes:
The change is delayed by 1 second but that is acceptable for what I am doing this for.
The sheet I am using this on is view only as this would constantly shift the focus to the first row if you have an idea on how to set the first row values without changing selection that would make this work great.
I am trying to use a button in Excel to copy a certain range of cells from the active workbook to another workbook. The copying works perfectly when I specify a fixed range for each button in its assigned Macro but I'm stumped as to how to use the same Macro on each button and for the button's row number to indicate the row of data to be copied.
Every row contains 6 or so cells with the 7th containing the button. When the user presses this button the 6 cells on the same row as the row containing the pressed button need to be copied.
I am a complete novice when it comes to VBScript but much googling has got me this far:
Sheets("SurfaceThreats").Range("A4:F4")Copy_
Sheets("ORBAT").Cells(Rows.Count,1).End(x1Up).Offset(1,0)
Surely there is a more elegant solution than assigning a different, fixed range, Macro to every button.
See this screenshot
And this is the code for the Select Row(s) button
Option Explicit
Private Sub CommandButton1_Click()
Dim Ret As Range, rng As Range
Dim lRow As Long
On Error Resume Next
Set Ret = Application.InputBox("Please select the row", Type:=8)
On Error GoTo 0
If Not Ret Is Nothing Then
For Each rng In Ret.Rows
'~~> Get the last row in sheets "ORBAT" where you want to copy
With Sheets("ORBAT")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
'~~> Copy the rows
Sheets("SurfaceThreats").Range("A" & rng.Row & ":F" & rng.Row).Copy _
Sheets("ORBAT").Cells(lRow, 1)
Next
End If
End Sub
You can't create a generic button handler, but you can dynamically create the buttons and the macros to handle them. But it's quite a lot of work and you'll have to start creating macros dynamically. (this can cause problems with anti-virus software sometimes i think).
You could use the Worksheet_OnBeforeDoubleClick event to create "fake" buttons
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Target.Worksheet.Columns(1)) Is Nothing Then
MsgBox "You Clicked " & Target.Address
' call your generic handler here passing the Target.Address or Target.Row
Cancel = True
End If
End Sub
Using this code, if you double click any cell in the "A" column you'll get a message box saying what cell you clicked.
Its not the best of ideas, some users might not understand that it is a button.