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
Related
I have a spreadsheet that has data validation in cells A2-A999 with the only option in the drop down menu being "Today" (without the quotation marks). I have a VBA code that changes the cell's value to today's date when "Today" is selected in the cell. However, this code has a problem. When I clear the contents of a group of cells, including the cell that has today's date in it, the spreadsheet thinks, then debugs and then closes; for example clearing A1 & B1 simultaneously.
However, if I clear A1 by itself, it clears the cell with no problems.
P.S. By " I clear", I meant to say: "I select the group of cells with the mouse and then hit the backspace button."
Can you guys help me fix the code so that I can clear many cells at the same time, including the cell with data validation.
The code that I am using is pasted in the worksheet section and is as the following:
Private Sub Worksheet_Change(ByVal Target As Range)
selectedVal = Target.Value
If Target.Column = 1 Then
selectedNum = Application.VLookup(selectedVal, Worksheets("DATA-
O").Range("DateToday"), 2, False)
If Not IsError(selectedNum) Then
Target.Value = selectedNum
End If
End If
End Sub
The answer to your problem is (as Dirk Reichel just mentioned in a comment) to loop through each of the affected cells:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Columns(1), Target) Is Nothing Then
For Each c In Intersect(Columns(1), Target).Cells
selectedVal = c.Value
selectedNum = Application.VLookup(selectedVal, Worksheets("DATA-O").Range("DateToday"), 2, False)
If Not IsError(selectedNum) Then
Application.EnableEvents = False 'As recommended by K Paul
c.Value = selectedNum
Application.EnableEvents = True
End If
Next
End If
End Sub
However, based on what you say that the code is doing, I'm not sure why you don't just use:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Columns(1), Target) Is Nothing Then
For Each c In Intersect(Columns(1), Target).Cells
If c.Value = "Today" Then
Application.EnableEvents = False 'As recommended by K Paul
c.Value = Date
Application.EnableEvents = True
End If
Next
End If
End Sub
If you want to be fast, there are 2 ways.
Use Evaluate to do it array-like:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Columns(1), Target) Is Nothing Then
With Intersect(Columns(1), Target)
If Evaluate("AND(" & .Address & "<>""Today"")") Then Exit Sub
.Value = Evaluate("IF(" & .Address & "=""Today"",TODAY()," & .Address & ")")
End With
End If
End Sub
or use Range.Replace which also can be very fast:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Columns(1), Target) Is Nothing Then
Intersect(Columns(1), Target).Replace "Today", Date, xlWhole, , True, , False, False
End If
End Sub
A small hint: hitting ctrl & ; will directly input todays date
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
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
I need some help with this code as it doesn't work properly.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("W:W").Column Then
Cells(.Row, "AC").Value = Int(Now)
End If
End With
Next Cell
End Sub
I am trying to get automatic static date stamps in column "AC" every time I fill in cells in column "W" and I want to start with row "19".
Tried to use
If .Column = Range("W19").End(xldown) Then
but it doesn't work.
I've just started using macro and vba and it will really help me if you can explain any solutions to me.
Thank you
Always turn off events if you are going to write to the worksheet in order that the Worksheet_Change event macro does not try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("W:W")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("W:W"))
If rng.Row > 18 Then _
rng.Offset(0, 6) = Date 'or Now for datetime
Next rng
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should handle multiple changes to column W like a block range paste.
I am trying to write a macro that runs automatically any time a sheet is edited. Column H has the heading "Updated on" and the macro should put today's date in cell H# where # is the row of the cell that was changed. Here's the code I used:
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Select
Range("H" & ActiveCell.Row).Select
ActiveCell.Value = Date
End Sub
After saving the workbook and changing the value of cell A2, the code put today's date into H2 as I expected, but then gave me an error. I clicked debug, and the Target.Select line was highlighted. I assumed that looping was the problem, so I updated the code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target.Select
Range("H" & ActiveCell.Row).Select
ActiveCell.Value = Date
Application.EnableEvents = True
End Sub
This time, I changed the value of cell B3, and it put today's date into B4. Then Excel partially froze: I could still edit that workbook, but I couldn't open or view any other workbook. I closed all the workbooks, but then Excel itself would not close and I had to use the Task Manager to end it.
Using
Private Sub Worksheet_Change(ByVal Target As Range)
Range("H" & Target.Row).Value = Date
End Sub
will give you better stability. Target is the range that's changed.
It's just possible (I'm at home so can't check) that changing the value re-fires the Worksheet_Change event. If so, then block the recursion with
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> Range("H" & Target.Row).Address Then
Range("H" & Target.Row).Value = Date
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
const DATE_COL as long = 8
Dim c as range
Set c = Target.Cells(1)
If c.Column = DATE_COL Then Exit Sub
On Error Goto haveError
Application.EnableEvents=False
Me.Cells(c.Row, DATE_COL).Value = Date
haveError:
Application.EnableEvents=True
End Sub