Compiling data using multiple criteria

[MSShuplat]

I have a data set which contains test results for students, and I need to be able to compile them onto separate sheets. The original sheet looks something like this:

Name...............Subject.......Date..........Score
Smith, John.......Reading.....4/7/15.........5.5
Smith, John.......Reading.....3/2/15.........6.4
Smith, John.......Math..........4/3/15........9.8
Smith, John.......Math..........1/27/15......7.6
Doe, Jane..........Math.........3/22/15........8.2
Doe, Jane..........Reading.....3/22/15.......7.1
Doe, Jane..........Math..........2/11/15......6.1
James, Tom.......Reading......4/6/15.......10.0
James, Tom.......Math..........4/6/15.......11.7
James, Tom.......Reading......2/27/15.....11.1
James, Tom.......Reading......1/9/15.......10.2
James, Tom.......Reading......12/12/14....8.7
James, Tom.......Math..........1/10/15......7.1

I need a new worksheet the will find each name and list it only once for each subject, then pull the dates and scores for each subject and display the most recent date, and the difference between the first score and the highest score. If the first score is the highest, it should display 0. If there is only one score for that subject, it should not pull it at all. So for the sample above, it would look something like this:

Name................Subject.....Date...........Gain
Smith, John.......Reading....4/7/15..........0.0
Smith, John.......Math........4/3/15..........2.2
Doe, Jane..........Math........3/22/15.........2.1
James, Tom.......Reading....4/6/15..........2.4
James, Tom.......Math........4/6/15..........4.6

And then a third tab that simply pulls the name once for each subject, along with the most recent date tested and the actual score for that date, like so:

Name................Subject.....Date.........Score
Smith, John.......Reading....4/7/15.........5.5
Smith, John.......Math........4/3/15.........9.8
Doe, Jane..........Math........3/22/15.......8.2
Doe, Jane..........Reading....3/22/15.......7.1
James, Tom.......Reading....4/6/15........10.0
James, Tom.......Math........4/6/15.........11.7

There may not be a simple solution for this, but I need to make Excel do as much of the work as possible. This will be used by multiple users who can do little more than copy paste, so the macros or formulas in place need to do the rest.

Thank you in advance for your help!

 

[MickG]

Try this for Data on sheet 1 and results on sheets 2 & 3.

[COLOR="Navy"]Sub[/COLOR] MG07Apr04
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, oMin [COLOR="Navy"]As[/COLOR] Date, oMax [COLOR="Navy"]As[/COLOR] Date, gmin [COLOR="Navy"]As[/COLOR] Range, gmax [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] g [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nMax [COLOR="Navy"]As[/COLOR] Double, cc [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = Dn.Value & "-" & Dn.Offset(, 1).Value
    [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
        .Add Txt, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Txt) = Union(.Item(Txt), Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
ReDim Ray(1 To .Count + 1, 1 To 4)
ReDim nRay(1 To .Count + 1, 1 To 4)
nRay(1, 1) = "Name": nRay(1, 2) = "Subject": nRay(1, 3) = "Date": nRay(1, 4) = "Gain"
c = 1
cc = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    oMin = Application.Min(.Item(K).Offset(, 2))
    oMax = Application.Max(.Item(K).Offset(, 2))
    nMax = Application.Max(.Item(K).Offset(, 3))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] g [COLOR="Navy"]In[/COLOR] .Item(K).Offset(, 2)
        [COLOR="Navy"]If[/COLOR] g.Value = oMin [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] gmin = g
        [COLOR="Navy"]If[/COLOR] g.Value = oMax [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] gmax = g
    [COLOR="Navy"]Next[/COLOR] g
        cc = cc + 1
        nRay(cc, 1) = Split(K, "-")(0): nRay(cc, 2) = Split(K, "-")(1)
        nRay(cc, 3) = oMax: nRay(cc, 4) = gmax.Offset(, 1)
        [COLOR="Navy"]If[/COLOR] .Item(K).Count > 1 [COLOR="Navy"]Then[/COLOR]
            Ray(1, 1) = "Name": Ray(1, 2) = "Subject": Ray(1, 3) = "Date": Ray(1, 4) = "Gain"
            c = c + 1
            Ray(c, 1) = Split(K, "-")(0): Ray(c, 2) = Split(K, "-")(1)
            [COLOR="Navy"]If[/COLOR] gmin.Offset(, 1).Value > gmax.Offset(, 1).Value [COLOR="Navy"]Then[/COLOR]
                Ray(c, 3) = oMax: Ray(c, 4) = "0.0"
            [COLOR="Navy"]Else[/COLOR]
                Ray(c, 3) = oMax: Ray(c, 4) = Abs(gmin.Offset(, 1) - nMax)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
Sheets("Sheet2").Range("A1").Resize(c, 4) = Ray
Sheets("Sheet3").Range("A1").Resize(cc, 4) = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[MSShuplat]

Thanks so much, Mick! This works perfectly.