Excel Filtering for a Summary Tab

I

ItalianPlatinum

Well-known Member
Joined
Mar 23, 2017
Messages
855
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have a 5k+ row sheet that contains Invoices, job Ids, Merchants, with Due Dates and Shipment dates among a lot of other unique data. I need a way to quickly and easily identify based off of year when something was shipped. I want to maintain one sheet lets call it data. Then be able to look at another sheet say (2024) or (2025) to reference right there automatically what has been shipped for that year. The sheet 2024 will have all the columns in the data tab that I populated. So essentially a summary filtered by Ship date of 2024. Would anyone be able to help? The user isn't very computer inclined so having them filter or advance filtering themselves is a no can do. I know Excel has FILTER and UNIQUE filter formulas that I think may work but I had issues getting them to work so looking for some help. Thank you in adcance!

Job #Shipment DateDue DateABCDXXXX
11/1/202312/2/2022AA121231234XXXX
21/1/202212/2/2021BB665577XXXX
31/1/202412/2/2023CC998824XXXX
410/1/20249/1/2024DD856874314XXXX
510/5/20209/5/2020EE101202303XXXX
69/9/20208/10/2020FF444555666XXXX
79/1/20248/2/2024GG888999110XXXX
811/1/202410/2/2024HH5687458742365XXXX
 
Sort by date Sort by votes
I only need 1 sheet so even clearing it and using a set sheet each time is doable - just wondering would that way create a whole new sheet each time button is pressed?
 
Upvote 0

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
This pastes the data into the "Summary" sheet.
VBA Code: 
Sub FilterByYear()
    Dim filterYear As Long
    Dim ws As Worksheet, summarySheet As Worksheet
    Dim lastRow As Long
    Dim rng As Range
  
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set summarySheet = ThisWorkbook.Worksheets("Summary")

    filterYear = ws.Range("M2").Value
    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
  
    ' Apply filter based on year
    ws.Range("A3:K" & lastRow).AutoFilter Field:=2, _
        Criteria1:=">=" & DateSerial(filterYear, 1, 1), _
        Operator:=xlAnd, _
        Criteria2:="<=" & DateSerial(filterYear, 12, 31)
  
    ' Check if there are visible rows
    On Error Resume Next
    Set rng = ws.Range("A4:K" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
  
    If Not rng Is Nothing Then
        ' Clear existing data on the Summary sheet
        summarySheet.Cells.Clear
      
        ' Copy filtered cells to the Summary sheet
        ws.Rows(3).Copy Destination:=summarySheet.Range("A1") ' Copy header
        rng.Copy Destination:=summarySheet.Range("A2")        ' Copy filtered data
    Else
        MsgBox "No data found for the specified year.", vbExclamation
    End If

    ws.AutoFilterMode = False
End Sub
 
Upvote 0
VBA solution
Right click on sheet tab (any sheet other than "DATA" sheet) - [View Code] and paste the code.
It runs when you change A2 (year)
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Sheets("data")
    If Target.Address(0, 0) <> "A2" Then Exit Sub
    Application.EnableEvents = False
    [a4].CurrentRegion.Offset(1).Clear
    If (Not Target Like "*[!0-9]*") * (Len(Target) = 4) Then
        With ws.[a1].CurrentRegion
            .AutoFilter 2, , 7, Array(0, "1/25/" & Target)
            .Copy [a4]
            .AutoFilter
        End With
    End If
    Application.EnableEvents = True
End Sub
Data Sheet
Book1
ABCDEFGHIJK
1Job #Shipment DateDue DateABCDXXXX
211/1/202312/2/2022AA121231234XXXX
321/1/202212/2/2021BB665577XXXX
431/1/202412/2/2023CC998824XXXX
5410/1/20249/1/2024DD856874314XXXX
6510/5/20209/5/2020EE101202303XXXX
769/9/20208/10/2020FF444555666XXXX
879/1/20248/2/2024GG888999110XXXX
9811/1/202410/2/2024HH5687458742365XXXX
DATA


Result sheet
Book1
ABCDEFGHIJK
1Year
22024
3
4Job #Shipment DateDue DateABCDXXXX
531/1/202412/2/2023CC998824XXXX
6410/1/20249/1/2024DD856874314XXXX
779/1/20248/2/2024GG888999110XXXX
8811/1/202410/2/2024HH5687458742365XXXX
Whatever
 
Upvote 0
Fuji said:
VBA solution
Right click on sheet tab (any sheet other than "DATA" sheet) - [View Code] and paste the code.
It runs when you change A2 (year)
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Sheets("data")
    If Target.Address(0, 0) <> "A2" Then Exit Sub
    Application.EnableEvents = False
    [a4].CurrentRegion.Offset(1).Clear
    If (Not Target Like "*[!0-9]*") * (Len(Target) = 4) Then
        With ws.[a1].CurrentRegion
            .AutoFilter 2, , 7, Array(0, "1/25/" & Target)
            .Copy [a4]
            .AutoFilter
        End With
    End If
    Application.EnableEvents = True
End Sub
Data Sheet
Book1
ABCDEFGHIJK
1Job #Shipment DateDue DateABCDXXXX
211/1/202312/2/2022AA121231234XXXX
321/1/202212/2/2021BB665577XXXX
431/1/202412/2/2023CC998824XXXX
5410/1/20249/1/2024DD856874314XXXX
6510/5/20209/5/2020EE101202303XXXX
769/9/20208/10/2020FF444555666XXXX
879/1/20248/2/2024GG888999110XXXX
9811/1/202410/2/2024HH5687458742365XXXX
DATA


Result sheet
Book1
ABCDEFGHIJK
1Year
22024
3
4Job #Shipment DateDue DateABCDXXXX
531/1/202412/2/2023CC998824XXXX
6410/1/20249/1/2024DD856874314XXXX
779/1/20248/2/2024GG888999110XXXX
8811/1/202410/2/2024HH5687458742365XXXX
Whatever
Click to expand...
Getting these errors trying your line of code. In order to input in A2 then I have to have my table sit below, in this case i shifted it to A4.

View attachment 119407
View attachment 119408
 
Upvote 0
Cubist said:
This pastes the data into the "Summary" sheet.
VBA Code: 
Sub FilterByYear()
    Dim filterYear As Long
    Dim ws As Worksheet, summarySheet As Worksheet
    Dim lastRow As Long
    Dim rng As Range
 
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set summarySheet = ThisWorkbook.Worksheets("Summary")

    filterYear = ws.Range("M2").Value
    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
 
    ' Apply filter based on year
    ws.Range("A3:K" & lastRow).AutoFilter Field:=2, _
        Criteria1:=">=" & DateSerial(filterYear, 1, 1), _
        Operator:=xlAnd, _
        Criteria2:="<=" & DateSerial(filterYear, 12, 31)
 
    ' Check if there are visible rows
    On Error Resume Next
    Set rng = ws.Range("A4:K" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
 
    If Not rng Is Nothing Then
        ' Clear existing data on the Summary sheet
        summarySheet.Cells.Clear
    
        ' Copy filtered cells to the Summary sheet
        ws.Rows(3).Copy Destination:=summarySheet.Range("A1") ' Copy header
        rng.Copy Destination:=summarySheet.Range("A2")        ' Copy filtered data
    Else
        MsgBox "No data found for the specified year.", vbExclamation
    End If

    ws.AutoFilterMode = False
End Sub
Click to expand...
Looks like it is working going to try a few more tests. Thank you.
 
Upvote 0
The images you attatched in #24 is not showing properly.
If the data starts from A4 and the headers are in row 3 then

Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Sheets("data")  '<--- change data to actual sheet name that holds the source data
    If Target.Address(0, 0) <> "A2" Then Exit Sub
    Application.EnableEvents = False
    [a4].CurrentRegion.Offset(1).Clear
    If (Not Target Like "*[!0-9]*") * (Len(Target) = 4) Then
        With ws.Range("a3", ws.Cells.SpecialCells(11))
            .AutoFilter 2, , 7, Array(0, "1/25/" & Target)
            .Copy [a4]
            .AutoFilter
        End With
    End If
    Application.EnableEvents = True
End Sub
 
Upvote 0
Fuji said:
The images you attatched in #24 is not showing properly.
If the data starts from A4 and the headers are in row 3 then

Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Sheets("data")  '<--- change data to actual sheet name that holds the source data
    If Target.Address(0, 0) <> "A2" Then Exit Sub
    Application.EnableEvents = False
    [a4].CurrentRegion.Offset(1).Clear
    If (Not Target Like "*[!0-9]*") * (Len(Target) = 4) Then
        With ws.Range("a3", ws.Cells.SpecialCells(11))
            .AutoFilter 2, , 7, Array(0, "1/25/" & Target)
            .Copy [a4]
            .AutoFilter
        End With
    End If
    Application.EnableEvents = True
End Sub
Click to expand...
I am typing into A2 and it isn't doing anything. Anything you can see I am doing wrong?

1731968579647.png

1731968604687.png
 
Upvote 0
If the source data resides in "data" tab and you wnat to extract data to "Summary" sheet, my code needs to place in "Summary" sheet.
The code should run each time you change Summary!A2.

However, if it does nothing currently, EnableEvents might be disabled somehow.

After you cut the code from "data" sheet and paste to "Summary sheet" (no need to change the code),

go to [View] - [Immediate Window] and copy this line
application.enableevents = true
and paste to Immediate Window then hit Enter key.
This will set the EnableEvents back to true.
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Delete the last character of cells in column "K" if it is equal to "X" or "x"
Replies
8
Views
123
Fuji
F
J
  • Question Question
Calculating time frames
Replies
2
Views
327
myall_blues
myall_blues
A
  • Locked
  • Question Question
Multiply an array based on date value entered.
Replies
1
Views
37
Fluff
Fluff
A
  • Question Question
Multiply an array based on date value entered.
Replies
8
Views
110
Fluff
Fluff
F
  • Solved
Put a mark on rows that have the same 10 digits but different last one digit
Replies
2
Views
187
feni1388
F

Forum statistics

Threads
1,223,782
Messages
6,174,520
Members
452,569
Latest member
Ron1970

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top