Excel 2007 Merged list (100 items) to form page (4 items on page) with formulas

[ccheider]

I have an Excel list (WS1) for a swim team(100kids). I also made a Excel Form (WS2) with 4 stoke slips per page. I would like to merged the form with all the swimmers that will attend that MEET. The form having formulas that would pull the Name, Group, DATE of MEET, Event#, Stroke Name (Free 1-10, Back 11-20, Breast 21-30, Fly 31-40) in race order (1-40) and each swimmer has two strokes at each meet.

Example of Excel list (WS1):
Meet dates Present Event# for Stroke
Name ............group....6-19....6-26....7-3... free back Breast Fly
Beth Wood....05-06..... x......... x....................1....11..................
John Roth.....05-06..... x......................x.........2............ 32........
Tom Smith....13-14...... x............ x......x...............20...............40

Example of Excel form (WS2):
Date of race 6-19 Name: Beth Wood
Age Group: 05-06 Event: 1 Stroke: FREE
______________________________________________

Date of race 6-19 Name: John Roth
Age Group: 05-06 Event: 2 Stroke: FREE
______________________________________________

Date of race 6-19 Name: Beth Wood
Age Group: 05-06 Event: 11 Stroke: Breast
______________________________________________


A few of the problems are making the list come up by Meet Date in order by race and having it generate 2 stokes per child. I would print off the forms before each MEET. Please let me know if this is possible to do...

CCheider

 

[MikeDBMan]

what do you mean by "having it generate 2 stokes per child". What is a stoke?

 

[ccheider]

Sorry that was STROKE! swim strokes are noted as Freesyle, Breast stroke, back stroke, or fly the number under the 4 columns is the code for the stroke.

 

[MikeDBMan]

This code creates a file with just the info you want in the order you want it so you can populate your template.

Option Base 1
Option Explicit

Sub DoIt()
Dim DataArray(1000, 10) As Variant
Dim Nbr As Long
Dim X, Y, Z, Zz, QQ As Long
Dim Headings(15, 1) As Variant
X = 2

Sheets("sheet1").Select

Y = 1
Do While True
    If Cells(1, Y).Value = Empty Then Exit Do
    Headings(Y, 1) = Cells(1, Y).Value
    Y = Y + 1
Loop


Do While True
    If Cells(X, 1).Value = Empty Then Exit Do 'stop accumulating data when the name in column A is blank
    For QQ = 3 To 5
        If Cells(X, QQ).Value = "x" Then
            Nbr = Nbr + 1
            DataArray(Nbr, 1) = Cells(X, 1).Value 'Name
            DataArray(Nbr, 2) = "'" & Cells(X, 2).Value 'Group
            If Cells(X, QQ).Value = "x" Then
                DataArray(Nbr, 3) = Cells(1, QQ).Value 'a date's events
            End If
            'DataArray(Nbr, 4) = Cells(X, 4).Value '6/26 events
            'DataArray(Nbr, 5) = Cells(X, 5).Value '7/3 events
            DataArray(Nbr, 6) = Cells(X, 6).Value 'Free
            DataArray(Nbr, 7) = Cells(X, 7).Value 'Back
            DataArray(Nbr, 8) = Cells(X, 8).Value 'Breast
            DataArray(Nbr, 9) = Cells(X, 9).Value 'Fly
        End If
    Next
    X = X + 1
Loop

Sheets("Sheet2").Select
Y = 0
For X = 1 To Nbr
    For QQ = 3 To 5
        If DataArray(X, QQ) <> Empty Then 'they are competing in the 1st event
            'Y = Y + 1
            'For Z = 1 To 3
            '    Cells(Y + 1, Z).Value = DataArray(X, Z)
            'Next
            For Z = 6 To 9
                If DataArray(X, Z) <> Empty Then
                    For Zz = 1 To 2
                        Cells(Y + 1, Zz).Value = DataArray(X, Zz)
                    Next
                    Cells(Y + 1, 3).Value = DataArray(X, QQ)
                    
                    Cells(Y + 1, 4).Value = DataArray(X, Z)
                    Y = Y + 1
                End If
            Next
        End If
    Next
Next

Range("A1:D" & Y).Select
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C1:C" & Y) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("D1:D" & Y) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
    .SetRange Range("A1:D" & Y)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With



End Sub

 

[ccheider]

Thank you for your reply and I hope you didn't have to work to hard on making this code. Please forgive my ignorance but where do I put these codes.

 

[MikeDBMan]

I suggest you send me the file. I'll "fix it up" and return it to you. My email is Mikedbman At Gmail dot com