switching rows to columns and removing multiples with variable row count

[fiscot]

Hello,
I would love o get some help with this problem, since it was quite some time i used excel for more than summing things up.

So - I've got a table with about 1000 rows, and four columns.

The first column has the ID of a place.
The second column has the name of that place
The second column has a date of when the place was inspected
The third column has the 0-5 verdict of the place

The problem is that each place are inspected various times so that some places have been inspected 4 times, and some 0.

This means that the table might look something like this:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Place
[/TD]
[TD]Name
[/TD]
[TD]Date
[/TD]
[TD]Verdict
[/TD]
[/TR]
[TR]
[TD]521
[/TD]
[TD]First place
[/TD]
[TD]2015.02.20
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]521
[/TD]
[TD]First place
[/TD]
[TD]2016.01.15
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]521
[/TD]
[TD]First place
[/TD]
[TD]2017.03.01
[/TD]
[TD]4
[/TD]
[/TR]
[TR]
[TD]622
[/TD]
[TD]Second place
[/TD]
[TD]2014.02.10
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]622
[/TD]
[TD]Second place
[/TD]
[TD]2017.01.10
[/TD]
[TD]4
[/TD]
[/TR]
[TR]
[TD]723
[/TD]
[TD]Third place
[/TD]
[TD]2016.08.10
[/TD]
[TD]1
[/TD]
[/TR]
</tbody>[/TABLE]

I need to get the last three times the places were inspected, what date and verdict laid out in columns, how do I do that?

How do I get that table to look like this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Place
[/TD]
[TD]Name
[/TD]
[TD]1st
[/TD]
[TD]Verdict
[/TD]
[TD]2nd
[/TD]
[TD]Verdict
[/TD]
[TD]3rd
[/TD]
[TD]Verdict
[/TD]
[/TR]
[TR]
[TD]521
[/TD]
[TD]First Place
[/TD]
[TD]2015.02.20
[/TD]
[TD]3
[/TD]
[TD]2016.01.15
[/TD]
[TD]3
[/TD]
[TD]2017.03.01
[/TD]
[TD]4
[/TD]
[/TR]
[TR]
[TD]622
[/TD]
[TD]Second Place
[/TD]
[TD]2014.02.10
[/TD]
[TD]2
[/TD]
[TD]2017.01.10
[/TD]
[TD]4
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]723
[/TD]
[TD]Third Place
[/TD]
[TD]2016.08.10
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Thanks for any help.

 

[Special-K99]

Is this a one off report? Or will you be adding to the list, ie
What happens if Place 521 gets inspected again (this will be it's 4th time) let's say on 2017.04.01 and gets verdict 2 ?
Will that get added to your original list. If so
all the dates shift left by one shouldnt they, to reflect the last 3 inspections, ie should it now look like this?

Place Name        1st        Verdict 2nd        Verdict 3rd        Verdict
521   First Place 2016.01.15       3 2017.03.01       4 2017.04.01       2

 

[fiscot]

Dear Special-K99,
Thank you for your answer.

I will be exporting the data from a website, say once a month. So I can just regenerate a completely new report each time if that is easier. But you are correct in that shifting should occur if new inspections were to be added to the old report. It would be great to automate the process of importing the new values into an old sheet, but I'm just trying to solve the main problem first.

Best regards,
Fiscot

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG03Mar01
[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] Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant, txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
        ReDim ray(1 To Rng.Count, 1 To 4)
ray(1, 1) = "Place": ray(1, 2) = "Name": ray(1, 3) = "1st": ray(1, 4) = "Verdict"
n = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        n = n + 1
        ray(n, 1) = Dn.Value
        ray(n, 2) = Dn.Offset(, 1).Value
        ray(n, 3) = Dn.Offset(, 2).Value
        ray(n, 4) = Dn.Offset(, 3).Value
        Dic.Add Dn.Value, Array(n, 4, 1)
    [COLOR="Navy"]Else[/COLOR]
       Q = Dic(Dn.Value)
       Q(1) = Q(1) + 2
       Q(2) = Q(2) + 1
       [COLOR="Navy"]If[/COLOR] Q(1) > UBound(ray, 2) [COLOR="Navy"]Then[/COLOR] ReDim Preserve ray(1 To Rng.Count, 1 To Q(1))
        [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Q(1)
            [COLOR="Navy"]Case[/COLOR] 6: txt = "nd"
            [COLOR="Navy"]Case[/COLOR] 8: txt = "rd"
            [COLOR="Navy"]Case[/COLOR] Else: txt = "th"
        [COLOR="Navy"]End[/COLOR] Select
        ray(1, Q(1)) = "Verdict": ray(1, Q(1) - 1) = Q(2) & txt
        ray(Q(0), Q(1)) = Dn.Offset(, 3).Value: ray(Q(0), Q(1) - 1) = Dn.Offset(, 2).Value
        Dic(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(Dic.Count + 1, UBound(ray, 2))
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick