Need Help Quick

[christ_is_the_one]

I have a excell workbook containing multiple sheets for a church camp roster. On sheet is the master list and the others are a list for each church (the other sheets don't have names they just count the ones from the master sheet and return a number).

I want to a few other sheets that take the roster and divide it into classes based on age. One sheet will be for 0-2 year olds and will contain only their names, the next will be for 3-4 yr olds and will contain only their names, etc.

I want these sheets to automatically take the info from the master roster sheet as it changes (as we add new people or take off people) based on these criteria.

The master sheet contains their names, ages, and various other info. I want to be able to take all of this info and put it on these new sheets as I explained above.

Any help is appreciated. Thanks.

Sims

 

[christ_is_the_one]

Only problem w/ that is that it doesn't change if I change the original data.

 

[daniels012]

I have button I created on each sheet that has a macro that will update everytime I hit the button. It works fine and adds the data right away.

Hope this helps,
Michael

 

[christ_is_the_one]

How do I create this button

 

[daniels012]

The easiest and best way! Record your Macro as you do your Filter.
Tools... Macro... Record New Macro. Here you can name it and put a description.
PLAN your RECORDING!! It copies EVERY move you make. So make sure you plan out what you are about to record.

Hope this Helps,
Michael

 

[sbendbuckeye]

Drop this code in a standard module and run it. You could actually resort by Reg # but I forgot about that until I was almost done, so I left the OrigRow stuff in for demonstration purposes. Good Luck!

Option Explicit

Sub ProcessRegistration()
Dim wks As Worksheet
Dim strTemp As String
Dim lngTemp As Long, lngRow As Long, lngSaveRow As Long, lngEndRow As Long, lngEndCol As Long
    'Set worksheet object - Use your sheet name here
    Set wks = Sheets("Sheet2")
    'Get last row and column
    wks.Select
    lngTemp = wks.Index
    lngEndRow = Cells.SpecialCells(xlCellTypeLastCell).Row
    lngEndCol = Cells.SpecialCells(xlCellTypeLastCell).Column
    
    'Add extra column so original order can be reset later
    'Create header
    Cells(1, lngEndCol + 1).Value = "OriginalRow"
    'Establish pattern
    Cells(2, lngEndCol + 1).Value = 1
    Cells(3, lngEndCol + 1).Value = 2
    'Copy to end of data
    Range(Cells(2, lngEndCol + 1), Cells(3, lngEndCol + 1)).AutoFill Destination:=Range(Cells(2, lngEndCol + 1), Cells(lngEndRow, lngEndCol + 1)), Type:=xlFillDefault

    'Sort the data
    Cells.EntireColumn.Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, _
        Key2:=Range("D2"), Order2:=xlAscending, _
        Key3:=Range("A2"), Order3:=xlAscending, Header:=xlYes, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
    
    'Process by Sex and Age - change Key1 -> D2 if sort by Age and Sex
    For lngRow = 2 To lngEndRow
        'Sex and/or Age have changed so create a new sheet
        If strTemp <> Range("C" & lngRow) & " " & Range("D" & lngRow) Then
            'Create sheet after the fact
            If lngRow > 2 Then
                Sheets.Add After:=Sheets(lngTemp)
                lngTemp = lngTemp + 1
                Sheets(lngTemp).Name = strTemp
                'Copy headers
                wks.Range(wks.Cells(1, 1), wks.Cells(1, lngEndCol)).Copy
                Sheets(lngTemp).Range("A1").PasteSpecial Paste:=xlPasteAll
                'Copy block of data
                wks.Range(wks.Cells(lngSaveRow, 1), wks.Cells(lngRow - 1, lngEndCol)).Copy
                Sheets(lngTemp).Range("A2").PasteSpecial Paste:=xlPasteAll
                Sheets(lngTemp).Cells.EntireColumn.AutoFit
                Sheets(lngTemp).Range("A1").Select
                wks.Select
            End If
            strTemp = Range("C" & lngRow) & " " & Range("D" & lngRow)
            lngSaveRow = lngRow
        End If
    Next lngRow
    
    'Don't forget the last one
    Sheets.Add After:=Sheets(lngTemp)
    lngTemp = lngTemp + 1
    Sheets(lngTemp).Name = strTemp
    'Copy headers
    wks.Range(wks.Cells(1, 1), wks.Cells(1, lngEndCol)).Copy
    Sheets(lngTemp).Range("A1").PasteSpecial Paste:=xlPasteAll
    'Copy block of data
    wks.Range(wks.Cells(lngSaveRow, 1), wks.Cells(lngRow - 1, lngEndCol)).Copy
    Sheets(lngTemp).Range("A2").PasteSpecial Paste:=xlPasteAll
    Sheets(lngTemp).Cells.EntireColumn.AutoFit
    Sheets(lngTemp).Range("A1").Select
    
    'Now resort registration sheet
    wks.Select
    Cells.EntireColumn.Select
    'Convert extra column number to column letter
    strTemp = Chr$(Asc("A") + (lngEndCol + 1) - 1)
    Selection.Sort Key1:=Range(strTemp & "2"), Order1:=xlAscending, _
        Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
    
    'Delete original row column
    Cells(1, lngEndCol + 1).EntireColumn.Delete
    Cells.EntireColumn.AutoFit
    Cells(1, 1).Select 'A2
    Set wks = Nothing
End Sub

 

[christ_is_the_one]

It comes up with an error. I will post it later.

 

[sbendbuckeye]

FYI, I tested the code before I posted it. Let me know...