Copy rows of data from one sheet to another based on value in a column on the first sheet

[Kristy Cathro]

Hi,

Apologies for the long title - I am a complete novice and have no idea what the correct terminology is that I need to use.

I have a database of rugby players who have registered at our rugby club. They get graded into specific grades. Rather the filtering the "grades column" and copying & pasting their data into a separate worksheet, I would like to filter out all the grades individually into their own worksheets, so when I add/edit/remove player's details on the main database worksheet, it will automatically be updated in the individual grade worksheets.

The below table is a watered down version of the real database. The actual database consists of columns A-AW and rows 1-280 (not too sure if this information is relevant or not)

Database Worksheet:

First Name	Last Name	DOB	Weight	Grade	Comment
John	Smith	12/02/2003	45	J2	In coach A's team please
Ben	Tucker	23/07/2006	32	J4	Same team as Peter Parker
Jason	Robertson	06/06/2009	14	J8	NA
Adrian	Adams	30/01/2010	19	J7	NA

<tbody>
</tbody>

Thanks
Kristy

 

[dmt32]

Hi,
welcome to the board.

See if following code helps:

Place code in a STANDARD module. (Alt+F11 takes you to VBA Editor) then from menu (INSERT > MODULE )

Option Explicit


Sub FilterData()
    'DMT32
    Dim ws1Master As Worksheet, wsNew As Worksheet, wsFilter As Worksheet
    Dim Datarng As Range, FilterRange As Range, objRange As Range
    Dim rowcount As Long
    Dim colcount As Integer, FilterCol As Integer, FilterRow As Long
    Dim SheetName As String, msg As String




    'master sheet
    Set ws1Master = ActiveSheet


    'set the Column you
    'are filtering
top:
    On Error Resume Next
    Set objRange = Application.InputBox("Select Field Name To Filter", "Range Input", , , , , , 8)
    On Error GoTo 0
    If objRange Is Nothing Then
        Exit Sub
    ElseIf objRange.Columns.Count > 1 Then
        GoTo top
    End If


    FilterCol = objRange.Column
    FilterRow = objRange.Row


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With


    On Error GoTo progend


    'add filter sheet
    Set wsFilter = Sheets.Add
    
    With ws1Master
        .Activate
        .Unprotect Password:=""  'add password if needed
        
        rowcount = .Cells(.Rows.Count, FilterCol).End(xlUp).Row
        colcount = .Cells(FilterRow, .Columns.Count).End(xlToLeft).Column


        If FilterCol > colcount Then
            Err.Raise 65000, "", "FilterCol Setting Is Outside Data Range.", "", 0
        End If


        Set Datarng = .Range(.Cells(FilterRow, 1), .Cells(rowcount, colcount))
        
        'extract Unique values from FilterCol
        .Range(.Cells(FilterRow, FilterCol), .Cells(rowcount, FilterCol)).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)
        
            'check for blank cell in range
            If Len(FilterRange.Value) > 0 Then
            
                'add the FilterRange to criteria
                wsFilter.Range("B2").Value = FilterRange.Value
                'ensure tab name limit not exceeded
                SheetName = Trim(Left(FilterRange.Value, 31))
                
                'check if Filter sheet exists
                On Error Resume Next
                 Set wsNew = Worksheets(SheetName)
                    If wsNew Is Nothing Then
                        'if not, add new sheet
                        Set wsNew = Sheets.Add(after:=Worksheets(Worksheets.Count))
                        wsNew.Name = SheetName
                    Else
                        'clear existing data
                        wsNew.UsedRange.Clear
                    End If
                On Error GoTo progend
                'add / update
                Datarng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsFilter.Range("B1:B2"), _
                                       CopyToRange:=wsNew.Range("A1"), Unique:=False


            End If
            wsNew.UsedRange.Columns.AutoFit
            Set wsNew = Nothing
        Next
        
        .Select
    End With
    


progend:
    wsFilter.Delete
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With


    If Err > 0 Then MsgBox (Error(Err)), 16, "Error"
End Sub

When run, an InputBox will appear - select with mouse Field Name you want to filter (Grade) & press ok.
Code will create sheets for each grade in list & add related records. When you update master list & run code, old data is cleared from existing sheets before records are copied to them.

Hope Helpful

Dave

 

[My Aswer Is This]

So you want a new sheet made for each value in column "B"
And the sheet will be named What?
The value in column "B"
So in this your example we will create 4 new sheets named "Smith" "Tucker" "Robertson" Adams"
And each new sheet will only have one row of data.
Do you want all new sheets to have a header row the same as in your Master sheet

 

[Kristy Cathro]

OMG!!! That is amazing!

You are a life saver! Thank-you so very much!!!

Last quick question: If I reformat the individual spreadsheets to appear a certain way (hide certain columns), when I re-run the macros, will it keep the saved formatting or will it revert to revealing all columns?

 

[Kristy Cathro]

@ My Answer Is This.....thanks, Dave's code did exactly what I needed. Thanks for the reply.

@Dave...still gobsmacked that a click of a button did just what I needed. My last reply was for you re: the formatting.

 

[dmt32]

OMG!!! That is amazing!

You are a life saver! Thank-you so very much!!!

Last quick question: If I reformat the individual spreadsheets to appear a certain way (hide certain columns), when I re-run the macros, will it keep the saved formatting or will it revert to revealing all columns?

Hi,
Glad solution helped you.

There have been many requests similar to yours here so I developed the solution to allow users to simply click on any field name they want to filter. Code is dynamic so as long as you have a row that has headers (field names) it will work on any other project you have where you need to perform similar task. Also, the advantage of using a filter is that it is extremely fast.

With regard to your formatting question – all you can do is try it but you will need to change a line of code:

Change this line:

wsNew.UsedRange.Clear

To This:

wsNew.UsedRange.ClearContents

The first line clears everything from the sheet including formats – the updated line should only clear cell values.

If however, this does not do what you want, let me know & will see what I can do to assist.

Hope Helpful

Dave

 

[Kristy Cathro]

Hi Dave,

I have been attempting to run this macros on an updated spreadsheet and I keep getting this error message and I'm not at all sure what it means or how to fix it.

FilterCol Setting is Outside of Data Range

Thanks
Kristy

 

[dmt32]

Hi Dave,

I have been attempting to run this macros on an updated spreadsheet and I keep getting this error message and I'm not at all sure what it means or how to fix it.

FilterCol Setting is Outside of Data Range

Thanks
Kristy

Hi Kristy.

It simply means that you clicked on a column that is not in the range of your data. e.g If your column headings are from A - K & you select a cell in say column M you will get that message.

Code is dynamic – based on heading you select, it will count how many columns (field headings) it can find in selected row & this will determine along with the row count, the range of your data to be filtered.

Hope Helpful

Dave