Excel VBA: Hiding columns between two given dates - vba

I'm working on a sheet listing days throughout the year. The rows will be populated manually by different users and the purpose is to log these values throughout a whole year. Columns are specific to each day of the year, and therefore a lot of scrolling is required to find a specific range.
What i want to achieve is to have two cells that can be filled with two dates, a start and end date, and when these are entered all the other columns are hidden from view.
I've found a method to hide columns before a given date in one cell, but id like some help to incorporate a way to also hide columns after a given date in another cell. In this case cell E35
The VBA code for the method so far is:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160725
Dim xCell As Range
If Target.Address <> Range("E34").Address Then Exit Sub
Application.ScreenUpdating = False
For Each xCell In Range("H1:NG1")
xCell.EntireColumn.Hidden = (xCell.Value < Target.Value)
Next
Application.ScreenUpdating = True
End Sub
A reference picture here:
Example
Thank you in advance // R

Following-up on #dgorti answer, in future cases, when you want to monitor the worksheet for multiple ranges, you can use:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E34:E35")) Is Nothing Then
' perform your code hewe
Else
' you can put your Exit Sub here
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160725
Dim xCell As Range
If Target.Address <> Range("E34").Address AND Target.Address <> Range("E35").Address Then Exit Sub
Application.ScreenUpdating = False
For Each xCell In Range("G1:NG1")
xCell.EntireColumn.Hidden = (xCell.Value < Range("E34").Value or xCell.Value > Range("E35").Value )
Next
Application.ScreenUpdating = True
End Sub

Related

Hide a row (in a list) based on drop-down multiple selection on each of the rows (not on a single cell)

I have a list of "activities" in column B and each of them has a drop-down list for the status in column C. For each activity I can select "Done, In progress, TBD, Cancelled". What I want is to hide a row automatically (not filtering) every time I choose the status "Cancelled" in the drop-down (located in the same row).
The code used is below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("C2:C21")
If Target.Address <> Range("C2:C21").Address Then
Exit Sub
Cells.EntireRow.Hidden = False
Select Case Range("C2:C21")
Case "Cancelled":
Range("2:21").EntireRow.Hidden = True - ***I want to hide only those rows in which "Cancelled" is selected.***
Case "Done":
Range("2:21").EntireRow.Hidden = False - ***I want the rows to unhide if either "Done","In progress" or "TBD" is selected.***
End Select
End Sub
It's probably a terrible code for what I want to do...
Any idea on how to improve this?
Thanks a lot in advance! :)
Sara
The rng object has never been used.
If you want to check the selection is in Range("C2:C21") or not, use a Intersect function.
The If statement can be completed without an End If only if it is one-lined. Otherwise you have to put an End If at the end.
Range("2:21").EntireRow.Hidden means every rows in 2:21 are going to be hidden.
Code:
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
For Each cel In rng
cel.EntireRow.Hidden = IIf(cel.Value = "Cancelled", True, False)
Next cel
End If
End Sub
I'm not sure the version below is fitted or not. In my opinion, generally this macro should only be run after something is changed, and we can only check the row who has been changed, other rows should remain the same state.
Private Sub Worksheet_Change(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
target.EntireRow.Hidden = IIf(target.Value = "Cancelled", True, False)
End If
End Sub
This is another option, skipping the If and Select Case:
Private Sub Worksheet_Change(ByVal target As Range)
Dim myRng As Range
Dim myCell As Range
Set myRng = Range("C2:C21")
If Not Intersect(myRng, target) Is Nothing Then
Cells.EntireRow.Hidden = False
For Each myCell In myRng
myCell.EntireRow.Hidden = CBool(myCell = "Cancelled")
Next myCell
End If
End Sub
The "beauty" is that the If condition is eliminated and the .Hidden is assigned to a direct evaluation of myCell = "Cancelled";
Furthermore, the code is in a worksheet, as far as the _SelectionChange event is used. Then the parent worksheet of the range could be omitted, as far as it is taking the worksheet in which the code resides. So - Target.Parent.Range could be nicely skipped.

Excel Link two cells in different sheets using when changed macro

I have an Excel workbook with multiple worksheets. I have a cell in WORKSHEET A with range name TRACK1 and a cell in WORKSHEET B with range name TRACK2.
Each TRACK1 and TRACK2 are validated from a list. The user can change either cell from the drop-down list shown when the cell is selected.
I want to be able to allow the user to change either and have the other be also changed to match. Change value of TRACK1 and TRACK2 is changed, and vice versa.
I know how to do this basic macro, but how to stop the event propagating?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("TRACK1")) Is Nothing Then
Range("TRACK2") = Range("TRACK1")
End If
If Not Application.Intersect(Target, Range("TRACK2")) Is Nothing Then
Range("TRACK1") = Range("TRACK2")
End If
End Sub
In worksheet A's code module, use:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("TRACK1")) Is Nothing Then
Worksheets("WORKSHEET B").Range("TRACK2") = Range("TRACK1")
End If
Application.EnableEvents = True
End Sub
In worksheet B's code module, use:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("TRACK2")) Is Nothing Then
Worksheets("WORKSHEET A").Range("TRACK1") = Range("TRACK2")
End If
Application.EnableEvents = True
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!

VBA define ranges and static date stamps

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.