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
Related
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
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
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.
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
I'm trying to figure out a VBA code that will allow me to prefill a certain cell with a number when I type in "X" in a cell right next to it. I can't figure out if I should use Range, or Insert, or what.
I cannot use a button and assign a macro to it because I need to see which cells I have put an "X" into.
This is what I have so far, but it's using a button with macro assigned to it:
490 is being entered into E9 and tabs over to F9 after the macro button is clicked:
Sub eightNineSpring()
Range("E9").Select
ActiveCell.FormulaR1C1 = "490"
Range("F9").Select
End Sub
as automation put in the worksheet you need it:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Count = 1 Then
If Target.Value = "x" Then Target.Offset(0, -1).Value = 490
End If
End Sub
or as formula in E1 then copy down
=IF(F1="x",490,"")
But keep in mind when deleting the "x" (or replace it with something different):
The function will empty the 490 again while the change event will not
When using a Change Events that makes a change, Application.Events should be turned off to avoid the code calling itself recursively.
The code below caters for one or more cells in E1:E10 being updated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("F1:F10"))
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rng2 In Range
If rng2.Value = "x" Then rng2.Offset(0, -1).Value = 490
Next
Application.EnableEvents = True
End Sub