Dividing data into different tabs

Lulu1000

New Member
Joined
Apr 23, 2021
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I am very new to this website so apologies if I have done anything wrong. I am also a very basic user in excel so for anything really technical I may need clear steps (Sorry!).

I have a spreadsheet similar to the uploaded picture. What I am trying to do is have a new tab for every supervisor name (column D) I can do this by just filtering the sheet and copying on to new tabs, however, I am looking for a way that this is automatic. each month I will transferring data over to sheet one and need new tabs for each supervisor so hoping there is a way that I can get it to automatically look through sheet one and only return details for a certain supervisor. In this example it would be one tab for Gary and one tab for Laura but I need all the columns to come through. I have tried lookups but I can not seem to get it right. any help would be amazing thank you very much.
 

Attachments

  • Excel.PNG
    Excel.PNG
    39.4 KB · Views: 8

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,915
Office Version
  1. 2019
Platform
  1. Windows
Hi,
welcome to forum

Try following & see if it does what you want

place code in a STANDARD module (Alt+F11)

VBA Code:
Option Explicit
Sub FilterColumn()
    'dmt32 aug 2020
    Dim wsData      As Worksheet, wsNames As Worksheet, wsFilter As Worksheet
    Dim Datarng     As Range, FilterRange As Range
    Dim rowcount    As Long
    Dim FilterCol   As Variant
    Dim SheetName   As String
  
    On Error GoTo progend
   
'your master sheet
    Set wsData = ThisWorkbook.Worksheets("Raw Data")
  
'Column you are filtering
    FilterCol = "D"
  
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
'add filter sheet
    Set wsFilter = ThisWorkbook.Worksheets.Add
  
    With wsData
        .Activate
'add password if needed
        .Unprotect Password:=""
      
        Set Datarng = .Range("A1").CurrentRegion
      
'extract values from FilterCol'to filter sheet
        .Cells(1, FilterCol).Resize(Datarng.Rows.Count).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=wsFilter.Range("A1"), Unique:=True
      
        rowcount = wsFilter.Cells(wsFilter.Rows.Count, "A").End(xlUp).Row
'set Criteria
        wsFilter.Range("B1").Value = wsFilter.Range("A1").Value
      
        For Each FilterRange In wsFilter.Range("A2:A" & rowcount)
            SheetName = CStr(Left(FilterRange.Text, 31))
'check for blank cell in range
            If SheetName <> "" Then
'add the FilterRange to criteria
'part matches
                'wsFilter.Range("B2").Value = FilterRange.Value
'exact matches only
                wsFilter.Range("B2").Formula = "=" & """=" & SheetName & """"
'check if sheet exists
                If Not Evaluate("ISREF('" & SheetName & "'!A1)") Then
'add new sheet
                    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
                End If
'set object variable to sheet
                Set wsNames = Worksheets(SheetName)
'clear sheet
                wsNames.UsedRange.Clear
'copy data
                Datarng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsFilter.Range("B1:B2"), _
                CopyToRange:=wsNames.Range("A1"), Unique:=False
            End If

'size column widths to match master
'NB - slows code down a little
            Datarng.Rows(1).Copy
            wsNames.UsedRange.Rows(1).PasteSpecial xlPasteColumnWidths
'clear from memory
            Set wsNames = Nothing
'clear clipboard
            Application.CutCopyMode = False
        Next
        .Select
    End With
  
progend:
    If Not wsFilter Is Nothing Then wsFilter.Delete
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
  
    If Err <> 0 Then MsgBox (Error(Err)), vbCritical, "Error"
      
End Sub

If code does go in right direction, it can be made to run automatically each time you open the workbook to refresh the data otherwise, and if not quite what you want, there are plenty here to offer further suggestions.

Hope Helpful

Dave
 
Solution

Lulu1000

New Member
Joined
Apr 23, 2021
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi,
welcome to forum

Try following & see if it does what you want

place code in a STANDARD module (Alt+F11)

VBA Code:
Option Explicit
Sub FilterColumn()
    'dmt32 aug 2020
    Dim wsData      As Worksheet, wsNames As Worksheet, wsFilter As Worksheet
    Dim Datarng     As Range, FilterRange As Range
    Dim rowcount    As Long
    Dim FilterCol   As Variant
    Dim SheetName   As String
 
    On Error GoTo progend
  
'your master sheet
    Set wsData = ThisWorkbook.Worksheets("Raw Data")
 
'Column you are filtering
    FilterCol = "D"
 
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
'add filter sheet
    Set wsFilter = ThisWorkbook.Worksheets.Add
 
    With wsData
        .Activate
'add password if needed
        .Unprotect Password:=""
     
        Set Datarng = .Range("A1").CurrentRegion
     
'extract values from FilterCol'to filter sheet
        .Cells(1, FilterCol).Resize(Datarng.Rows.Count).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=wsFilter.Range("A1"), Unique:=True
     
        rowcount = wsFilter.Cells(wsFilter.Rows.Count, "A").End(xlUp).Row
'set Criteria
        wsFilter.Range("B1").Value = wsFilter.Range("A1").Value
     
        For Each FilterRange In wsFilter.Range("A2:A" & rowcount)
            SheetName = CStr(Left(FilterRange.Text, 31))
'check for blank cell in range
            If SheetName <> "" Then
'add the FilterRange to criteria
'part matches
                'wsFilter.Range("B2").Value = FilterRange.Value
'exact matches only
                wsFilter.Range("B2").Formula = "=" & """=" & SheetName & """"
'check if sheet exists
                If Not Evaluate("ISREF('" & SheetName & "'!A1)") Then
'add new sheet
                    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
                End If
'set object variable to sheet
                Set wsNames = Worksheets(SheetName)
'clear sheet
                wsNames.UsedRange.Clear
'copy data
                Datarng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsFilter.Range("B1:B2"), _
                CopyToRange:=wsNames.Range("A1"), Unique:=False
            End If

'size column widths to match master
'NB - slows code down a little
            Datarng.Rows(1).Copy
            wsNames.UsedRange.Rows(1).PasteSpecial xlPasteColumnWidths
'clear from memory
            Set wsNames = Nothing
'clear clipboard
            Application.CutCopyMode = False
        Next
        .Select
    End With
 
progend:
    If Not wsFilter Is Nothing Then wsFilter.Delete
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
 
    If Err <> 0 Then MsgBox (Error(Err)), vbCritical, "Error"
     
End Sub

If code does go in right direction, it can be made to run automatically each time you open the workbook to refresh the data otherwise, and if not quite what you want, there are plenty here to offer further suggestions.

Hope Helpful

Dave
This worked fantastically thank you!!!! do you know how to get it to run after you change the data on the first sheet? So it will run when I upload new data?

Again thank you so much for this didnt even know where to start
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,915
Office Version
  1. 2019
Platform
  1. Windows
This worked fantastically thank you!!!! do you know how to get it to run after you change the data on the first sheet? So it will run when I upload new data?

Again thank you so much for this didnt even know where to start

Glad suggestion does what you want

Simplest way to update would be to place a button on your master sheet & assign it to the macro.
You can then press button to perform the update after you have made all the changes.

Dave
 

Lulu1000

New Member
Joined
Apr 23, 2021
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Glad suggestion does what you want

Simplest way to update would be to place a button on your master sheet & assign it to the macro.
You can then press button to perform the update after you have made all the changes.

Dave
Thank you,
 

Forum statistics

Threads
1,147,498
Messages
5,741,504
Members
423,663
Latest member
kaveh87rsh

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
Top