Filter into sheets with Excel functions for Office 2016

tompf

New Member
Joined
May 25, 2016
Messages
3
Hi community,

Is there a way in Office 2016 (which offers no filter function) to filter the following main-sheet (containing all data) into sub sheets?
Like sheet 1 ="Jeff", containing only Jeff's data
sheet 2 ="Maria", containing only Maria's data
and so on...

Thanks for help and time!
Regards, Thomas
Customer​
Salesgroup​
Sales People​
Turnover - 2017/2018Open Orders 2017/2018
Company 1​
75​
Jeff​
19.085,86​
0,00​
Company 2​
75​
Jeff​
0,00​
0,00​
Company 3​
41​
Maria​
0,00​
19.500,00​
Company 4​
41​
Maria​
0,00​
90.000,00​
Company 5​
75​
Jeff​
15.849,11​
13.974,79​
Company 6​
41​
Maria​
0,00​
13.723.121,79​
Company 7​
75​
Jeff​
0,00​
530,00​
Company 8​
41​
Maria​
33.800,00​
1.103.614,75​
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Here's a VBA option - place it in a standard module. Assumes the headings on your main-sheet are in row 1, and that Customer is in column A. Change the name of your main-sheet where indicated in the code, and please test it on a copy of your workbook.

VBA Code:
Option Explicit
Sub SplitSheets()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual name of main-sheet ***
    Dim d As Object, arr, a, i As Long, sName As String
    
    Set d = CreateObject("scripting.dictionary")
    arr = ws.Range("C2", ws.Cells(Rows.Count, "C").End(xlUp))
    For i = 1 To UBound(arr, 1)
        d(arr(i, 1)) = 1
    Next i
    
    a = d.keys
    For i = LBound(a) To UBound(a)
        sName = a(i)
        If WorksheetExists(sName) Then
            MsgBox "Sheet " & a(i) & " already exists in this workbook.  Exiting sub"
            Exit Sub
        Else
            ws.Copy after:=ws
            ActiveSheet.Name = a(i)
            With ActiveSheet.Range("A1").CurrentRegion
                .AutoFilter 3, "<>" & a(i)
                .Offset(1).EntireRow.Delete
                .AutoFilter
            End With
        End If
    Next i
End Sub

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function
 
Upvote 0
Here's a VBA option - place it in a standard module. Assumes the headings on your main-sheet are in row 1, and that Customer is in column A. Change the name of your main-sheet where indicated in the code, and please test it on a copy of your workbook.

VBA Code:
Option Explicit
Sub SplitSheets()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual name of main-sheet ***
    Dim d As Object, arr, a, i As Long, sName As String
   
    Set d = CreateObject("scripting.dictionary")
    arr = ws.Range("C2", ws.Cells(Rows.Count, "C").End(xlUp))
    For i = 1 To UBound(arr, 1)
        d(arr(i, 1)) = 1
    Next i
   
    a = d.keys
    For i = LBound(a) To UBound(a)
        sName = a(i)
        If WorksheetExists(sName) Then
            MsgBox "Sheet " & a(i) & " already exists in this workbook.  Exiting sub"
            Exit Sub
        Else
            ws.Copy after:=ws
            ActiveSheet.Name = a(i)
            With ActiveSheet.Range("A1").CurrentRegion
                .AutoFilter 3, "<>" & a(i)
                .Offset(1).EntireRow.Delete
                .AutoFilter
            End With
        End If
    Next i
End Sub

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function
Thanks Kevin for your code!
Always amazing, how many different approaches exist....

At
Excel Alternatives to FILTER Function: A Simple Solution for Beginners - Sheet Skunk
there is a formula (sample dataset is available there!) which involves a combination of the INDEX, AGGREGATE, and ROW(S) functions.
The formula
=INDEX($B$8:$B$13,AGGREGATE(15,6,ROW($B$8:$B$13)-ROW($B$8)+1/($B$8:$D$13=$G$7),ROWS(I$10:I10)))
provides the same output as the FILTER function in Office 365.

Credits: Sheet Skunk. :)

Thanks and regards,
Thomas
 
Upvote 0
You are welcome.
Glad we were able to help!
 
Upvote 0

Forum statistics

Threads
1,215,133
Messages
6,123,234
Members
449,092
Latest member
SCleaveland

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