Question : Make list of all changes in the next 5 days

Hi All,

I am working on the attached spreadsheet and I was hoping to be able to automatically populate the Calendar tab by searching all the other tabs for dates within the next 5 days.

Is that possible? can someone help me out with the VB Script to do it?

It would be ideal if it could happen when you select that tab.

Thanks in advance.

Attachments:

Change-Managment-2-.xlsx (67 KB) (File Type Details)

Change Spreadsheet

Answer : Make list of all changes in the next 5 days

Worksheet name added to column A

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

           
           
             'This sub must be installed in the code pane for the calendar worksheet. It will not work at all if installed anywhere else.
Private Sub Worksheet_Activate()
Dim ws As Worksheet, wsCalendar As Worksheet
Dim rg As Range, rgDest As Range
Dim n As Long
Application.ScreenUpdating = False
Set wsCalendar = Worksheets("Calendar")
wsCalendar.Rows(2).Resize(wsCalendar.Rows.Count - 1).Delete
For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
    Case "Calendar", "Home", "Working Space"   'Ignore these worksheets
    Case Else
        With ws
            Set rg = .Range("B4").Resize(.UsedRange.Rows.Count, 5)    'Look at columns B:F, starting in row 4
            If (Not Intersect(rg, .UsedRange) Is Nothing) And (rg.Cells(1, 2) <> "") Then
                rg.AutoFilter Field:=2, Criteria1:="<=" & (Date + 5), Operator:=xlAnd, Criteria2:=">=" & (Date - 5)
                Set rgDest = wsCalendar.Cells(wsCalendar.UsedRange.Rows.Count + wsCalendar.UsedRange.Row, 2)
                .AutoFilter.Range.Copy rgDest
                n = wsCalendar.UsedRange.Rows.Count + wsCalendar.UsedRange.Row - rgDest.Row
                rgDest.Offset(0, -1).Resize(n, 1).Value = ws.Name
                rgDest.Rows(1).EntireRow.Delete
                .Range("B4").AutoFilter
            End If
        End With
    End Select
Next
Application.ScreenUpdating = True
End Sub
           
         