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
Related
I am trying to run this worksheet change event for two different columns(A) and (I)...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, B As Range, Inte As Range, r As Range
Set A = Range("A:A")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
r.Offset(0, 1).Value = Date
Next r
Application.EnableEvents = True
End Sub
This event is something i found on this forum. Its purpose is to make it so whenever data is ever entered into column "a" it auto inputs the date into the cell directly right of it. I want this to happen twice on the worksheet. I can't figure out how to change/add to it. I am trying to get it to run the logic for column A and I on my spreadsheet.
Just expand the range you set to the A variable.
Set A = Range("A:A, I:I")
Rewritten as,
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(range("A:A, I:I"), target) is nothing then
'add error control
on error goto safe_exit
'don't do anything until you know something has to be done
dim r as range
Application.EnableEvents = False
For Each r In intersect(range("A:A, I:I"), target)
r.Offset(0, 1).Value = Date 'do you want Date or Now?
Next r
end if
safe_exit:
Application.EnableEvents = True
End Sub
edited after OP's comment
expanding on #Jeeped solution, you can avoid looping:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A:A, I:I"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
when I am trying to execute this code it only executes the part after Exit Sub , only the foreach loop is executed, when the sheet is unprotected. I think it is caused by the Exit Sub. My problem is that I want to execute to different codes one when the sheet is protected (for each cell in Range("B6:B112..)) and the other(starting at Dim rng as Range..) when the sheet is unprotected. I tried If..Then..Else but that does not work.
Private Sub Worksheet_Change(ByVal Target As Range)
If Worksheets("test").ProtectContents Then Exit Sub
For Each cell In Range("B6:B112")
If cell.Value <> "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = True
End If
Next cell
Dim rng As Range
Dim eingabeNr As Double, letzteZeile As Long, eingabeDatum As String, eingabeNrString As String
Set rng = Range("D:BC")
THX.
Private Sub Worksheet_Change(ByVal Target As Range)
If Worksheets("test").ProtectContents = True Then 'added = true for readability.
For Each cell In Range("B6:B112")
If cell.Value <> "" Then
cell.EntireRow.Hidden = False
Else
cell.EntireRow.Hidden = True
End If
Next cell
Else
Dim rng As Range
Dim eingabeNr As Double, letzteZeile As Long, eingabeDatum As String,_
eingabeNrString As String
Set rng = Range("D:BC")
Do some stuff here
End if
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 a VBA code to capitalize most of my worksheet but when I delete or clear the contents I get the debug message.
Any help would be appreciated!
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A:Z")) Is Nothing Then
Target.Value = UCase(Application.Substitute(Target.Value, " ", ""))
End If
Application.EnableEvents = True
End Sub
If you delete/change/add more than a single cell then Target is more than one cell and you cannot make the value uppercase as you are doing. Loop through the intersection of Target and columns A:Z and make each uppercase.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A:Z")) Is Nothing Then
dim rng as range
for each rng in Intersect(Target, Range("A:Z"))
rng.Value = UCase(Replace(rng.Value, chr(32), vbnullstring))
next rng
End If
Application.EnableEvents = True
End Sub
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