Dynamic hyperlink that filters a table based on the ActiveCell value (VBA) - vba

I'm creating a dynamic hyperlink that will filter a table on another sheet (Sheet15).
My goal is to have the user be able to select a cell on Sheet3 and have the VALUE of this cell be the filter on the other sheet.
Here is my code so far:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
Application.ScreenUpdating = False
Sheet15.Visible = True
Sheet15.ListObjects("Table17").Range.AutoFilter Field:=19, Criteria1:=ActiveCell.Value
Sheet15.Activate
Application.ScreenUpdating = True
End If
End Sub
However, when I click the hyperlink, the table is not filtered at all, so I gotta be doing something wrong.
Can anyone assist?
UPDATE
Here is updated code.
Cell S17 is now the value that I want to filter the table to:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
Application.ScreenUpdating = False
Sheet15.Visible = True
Sheet15.ListObjects("Table17").Range.AutoFilter Field:=19, Criteria1:=Sheet3.Range("S17").Value
Sheet15.Activate
Application.ScreenUpdating = True
End If
End Sub
But the issue remains. When I click they hyperlink, I will be brought to this other sheet, but the table is not filtered at all.

sticking to your original plans, and assuming column "A" is the one with cities names, place the following in your worksheet code pane
Option Explicit
Dim lastCell As Range '<--| declare a module scoped range variable to store the last cell selected by the user, if "valid"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$S$15" Then Exit Sub '<-- do nothing if user selected cell with hyperlink
Set lastCell = Intersect(Target, Columns("A")) '<-- change "Columns("A") to a named range with your cities
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If lastCell Is Nothing Then Exit Sub '<--| no action if lastCell has not been properly set by 'Worksheet_SelectionChange()'
If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
Application.ScreenUpdating = False
Sheet15.Visible = True
Sheet15.ListObjects("Table17").Range.AutoFilter Field:=19, Criteria1:=lastCell.Value '<--| set the criteria as 'lastCell' value
Sheet15.Activate
Application.ScreenUpdating = True
End If
End Sub
as per comments, you change Columns("A") reference in Worksheet_SelectionChange() to your actual range with cities names (perhaps a named range)

Note: unless the hyperlink points to itself, ActiveCell.Value will be the value at the link destination: use Target.Range.Value if you want the value from the cell containing the link.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Target.Type = msoHyperlinkRange And Target.Range.Address = "$S$15" Then
Application.ScreenUpdating = False
With Sheet15
.Visible = True
.ListObjects("Table17").Range.AutoFilter Field:=19, _
Criteria1:=Target.Range.Value
.Activate
End With
Application.ScreenUpdating = True
End If
End Sub

Related

Hide columns and multiple sheets using loop

I currently have a loop that works great to hide columns based on multiple dropdown cells. I would also like to add code to hide sheets based on the same drop downs, but I'm not sure how to add on to my For Each Cell In Range to accommodate that. I have pasted what I have to hide the columns below. Any help would be greatly appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
For Each cell In Range("$A$30:$A$38")
If cell = "Descriptor 1" Or cell = "Descriptor 2" Then
Columns("B:F").EntireColumn.Hidden = False
Exit For
Else
Columns("B:F").EntireColumn.Hidden = True
End If
Next Cell
You can use something like Worksheets("sheet_to_hide").Visible = xlSheetHidden to hide a sheet and Worksheets("sheet_to_unhide").Visible = xlSheetVisible to unhide it again.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim HideIt As Boolean
HideIt = True
For Each cell In Range("$A$30:$A$38")
If cell.Value = "Descriptor 1" Or _
cell.Value = "Descriptor 2" Then
HideIt = False
Exit For
End If
Next Cell
If HideIt Then
Columns("B:F").Hidden = True
Worksheets("Sheet1").Visible = xlSheetHidden
Worksheets("Sheet2").Visible = xlSheetHidden
Else
Columns("B:F").Hidden = False
Worksheets("Sheet1").Visible = xlSheetVisible
Worksheets("Sheet2").Visible = xlSheetVisible
End If
End Sub
If the worksheets are to be hidden / made visible depending on whether their sheet name appears in your range, then I would suggest the following modification:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim HideIt As Boolean
'Don't do anything if there was no change to A30:A38
If Intersect(Target, Range("$A$30:$A$38")) Is Nothing Then Exit Sub
HideIt = True
For Each cell In Range("$A$30:$A$38")
If cell.Value = "Descriptor 1" Or _
cell.Value = "Descriptor 2" Then
HideIt = False
Exit For
End If
Next cell
Columns("B:F").Hidden = HideIt
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then
'See if sheet name exists in A30:A38
'Hide the sheet if doesn't, make it visible if it does
ws.Visible = Not IsError(Application.Match(ws.Name, Range("$A$30:$A$38"), 0))
End If
Next
End Sub
#YowE3K Your code is great. But I had a problem with the tab names being in short form and my descriptors being in full form. So, I took your original code, added a "HideTab" for each tab, and switched the topline HideTab = False to true and reversed it in the 4th line HideTab (See below). I'm sure there is a faster way, but this worked like a charm. Thank you very much for your help! You pointed me in the right direction.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim HideIt As Boolean
HideIt = True
For Each cell In Range("$A$30:$A$38")
If cell.Value = "Descriptor 1" Or
cell.Value = "Descriptor 2" Then
HideIt = False
Exit For
End If
Next Cell
Columns("B:F").EntireColumn.Hidden = True
Dim HideTab1 As Boolean
HideTab1 = False
For Each cell In Range("$A$30:$A$38")
If cell = "Descriptor1" Then
HideTab1 = True
Exit For
End If
Next cell
Sheets("Desc1").Visible = HideTab1
Dim HideTab2 As Boolean
HideTab2 = False
For Each cell In Range("$A$30:$A$38")
If cell = "Descriptor2" Then
HideTab2 = True
Exit For
End If
Next cell
Sheets("Desc2").Visible = HideTab2
Dim HideTab3 As Boolean
HideTab3 = False
For Each cell In Range("$A$30:$A$38")
If cell = "Descriptor3" Then
HideTab3 = True
Exit For
End If
Next cell
Sheets("Desc3").Visible = HideTab3
End Sub

VBA recognizing more than one cell is highlighted

I have the following VBA script:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("calendar")) Is Nothing Then
[selectedCell1] = ActiveCell.Value
Application.ScreenUpdating = True
End If
End Sub
Currently, It recognizes only one cell is highlighted and returns it into the specific cell named selectedCell1.
This is my example:
If I select the cell N25 which contains the date "03/08/2017" it returns "03/08/2017" into another sheet cell named "selectedCell1".
But what I would like it to do, is realize I've selected the entire week, and then return that entire week range in cell "selectedCell1". See:
And then return 01/08/2017 - 05/08/2017 (that entire range) in cell "selecetedCell1".
Not sure how to adjust this VBA script. Help would be appreciated. Thanks.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("calendar")) Is Nothing Then
If Target.Cells.Count = 1 Then
[selectedCell1] = Target.Value
Else
[selectedCell1] = Format(Application.WorksheetFunction.Min(Target), "dd/mm/yyyy") & " - " & Format(Application.WorksheetFunction.Max(Target), "dd/mm/yyyy")
End If
Application.ScreenUpdating = True
End Sub

VBA - autoupdate filter in excel after entering data

I'm fairly new to VBA and have been trying to get my spreadsheets to do a little more than just pivot tables allow. I've been able to set up some autofilters in excel using VBA, but now I'd like to have the worksheet autofilter after I enter data into a cell. However, neither of the two lines below work after I press enter.
Here are the two various lines of code I've tried:
1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$5" Then
Application.EnableEvents = False
FilterTo1Critera
Application.EnableEvents = True
End If
End Sub
2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cel As Range
Set ws = ThisWorkbook.Sheets("Sheet3")
If Not Intersect(Target, Range("A3")) Is Nothing Then
For Each cel In Target
Range("A3").Value = "Changed"
Application.EnableEvents = False
If IsEmpty(ws.Range("A")) Then Sheet1.Range("A").Value = 0
Application.EnableEvents = True
Next cel
End If
End Sub
What's the correct approach to take? Also, is there some good classes that I can take to brush up on some of these concepts??
Thanks in advance!

Excel VBA WorkSheet_Change Clear Contents If Blank

I'm setting a Worksheet_Change Macro so that if the contents of Cell K4 are not equal to "Event Based" the contents of J5:K7 are cleared. This works great. Code below.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MRange As Range
Set MRange = Range("K4")
If MRange <> "Event Based" Then
If Union(Target, MRange).Address = MRange.Address Then
Application.EnableEvents = False
Range("J5:K7").Select
Selection.ClearContents
Application.EnableEvents = True
End If
End If
End Sub
But I want a Worksheet_Change event if contents of cell J12 are cleared. But the below macro does NOT work. I know it is to do with cell value being empty, but I would appreciate any help.
Dim NRange As Range
Set NRange = Range("J12")
If NRange = "" Then
If Union(Target, NRange).Address = NRange.Address Then
Application.EnableEvents = False
Range("J5:K7").Select
Selection.ClearContents
Application.EnableEvents = True
End If
End If
End Sub
The code below checks if Cell J12 value has changed, if cell's value is "" then it clears the content of Range "J5:K7".
Private Sub Worksheet_Change(ByVal Target As Range)
Dim IntersectRange As Range
Dim NRange As Range
Set NRange = Range("J12")
Set IntersectRange = Intersect(Target, NRange)
' continue running this code only if Cell J12 has changed
If Not IntersectRange Is Nothing Then
If Target.Value = "" Then
Application.EnableEvents = False
Range("J5:K7").ClearContents
Application.EnableEvents = True
End If
End If
End Sub

VBA to select sheet based on cell value of another sheet

On Sheet 1(viva-2) Row 11 has a drop-down(validation) with yes/no.
By default, value will be "no" and sheet 11(Manage-d) cell range A11:D30 should be disabled/locked.
Selecting "Yes", user should be able to select Sheet11(Manage-d) and cells from range A11:D30 should be unlocked.
I am new to VBA, but I am putting my effort to learn.
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RNG As Range
If Target.Row = 11 Then
If Range("11").Value = "YES" Then
Sheets("Manage-d").Select
Sheets("Manage-d").Range("A11:D30").Locked = False
Sheets("Manage-d").Range("A11:D30").Activate
Else
Sheets("Manage-d").Range("A11:D30").Locked = True
End If
End If
Range object represents a single cell or a range of cells.This code is working for me
If Range("A1").Value = "YES" Then '' Range A1 is the first cell
Sheets("Manage-d").Select
Sheets("Manage-d").Range("A11:D30").Locked = False
Sheets("Manage-d").Range("A11:D30").Activate
Else
Sheets("Manage-d").Range("A11:D30").Locked = True
End If
I use the Worksheet_Change instead of the Worksheet_SelectionChange so that the user doesn't have to ciack another cell to trigger the macro.
Assuming the drop-down(validation) is in Range("A11"):
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A11")) Is Nothing Then
With Sheets("Manage-d")
.Range("A11:D30").Locked = (UCase(Target.Value) = "NO")
If UCase(Target.Value) = "YES" Then
Application.Goto .Range("A11:D30"), True
End If
End With
End If
End Sub