Between breaks decide which three values are highest and delete the rest.

[alocke]

Say I have the following table (A much smaller one than the one I actually have):
[TABLE="width: 500"]
<tbody>[TR]
[TD]Japan[/TD]
[TD]Time[/TD]
[/TR]
[TR]
[TD]RacerA[/TD]
[TD]44[/TD]
[/TR]
[TR]
[TD]RacerB[/TD]
[TD]23[/TD]
[/TR]
[TR]
[TD]RacerC[/TD]
[TD]154[/TD]
[/TR]
[TR]
[TD]RacerD[/TD]
[TD]17[/TD]
[/TR]
[TR]
[TD]RacerE[/TD]
[TD]16[/TD]
[/TR]
[TR]
[TD]China[/TD]
[TD]Time[/TD]
[/TR]
[TR]
[TD]RacerA[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]RacerB[/TD]
[TD]165[/TD]
[/TR]
[TR]
[TD]Romania[/TD]
[TD]Time[/TD]
[/TR]
[TR]
[TD]RacerA[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]RacerB[/TD]
[TD]16[/TD]
[/TR]
[TR]
[TD]RacerC[/TD]
[TD]19[/TD]
[/TR]
[TR]
[TD]RacerD[/TD]
[TD]24[/TD]
[/TR]
[TR]
[TD]RacerE[/TD]
[TD]130[/TD]
[/TR]
</tbody>[/TABLE]

I want to go through the list and delete all other times except the top 3 for each country and the corresponding racer.

My idea was having a column with =COUNTIF() and therefore displaying:
[TABLE="width: 500"]
<tbody>[TR]
[TD]5[/TD]
[/TR]
[TR]
[TD]2[/TD]
[/TR]
[TR]
[TD]5[/TD]
[/TR]
</tbody>[/TABLE]
Therefore if <2 then ignore and skip this particular case.


I was thinking a way to skip between cases... I guess if you know the number of racers you can compare all their times and then rank the top 3 but I dont know how to do that.... I've had a dig at it but got nowhere - any advice on how/where to go would be v appreciated!

Thanks.

Code so far:

Private Sub fixIT()
    Dim lr As Long
    Dim impCell As Range
    'refering to the countif column
    impCell = Range("C1")
    'refering to the Column that has all the time values.
    lr = Range("B" & Rows.Count).End(xlUp).Row
    Range("B1").Select
    For j = 1 To lr
        
    'If impCell.value < 3 then goto Line 1
        'If ActiveCell.Value is not in top 3 then
        ActiveCell.Delete shift:=xlUp
        ActiveCell.Offset(0, -1).Delete shift:=xlUp
Line1:
        Else
        ActiveCell.Offset(1, 0).Select
        End If
    Next
End Sub

 

[MickG]

Try this for data starting "A1".

[COLOR="Navy"]Sub[/COLOR] MG27Jul51
[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] Temp [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) And Dn.Offset(, 1).Value = "Time" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Temp = Dn
    Dic.Add Temp, Nothing
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]If[/COLOR] Dic(Temp) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Dic(Temp) = Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Dic(Temp) = Union(Dic(Temp), Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] P [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
  [COLOR="Navy"]If[/COLOR] Dic(K).Count > 3 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] n = 1 To 3
        [COLOR="Navy"]With[/COLOR] Application
            nStr = nStr & IIf(nStr = "", .Large(Dic(K).Offset(, 1), n), "," & .Large(Dic(K).Offset(, 1), n))
        [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] P [COLOR="Navy"]In[/COLOR] Dic(K)
        [COLOR="Navy"]If[/COLOR] InStr(nStr, P.Offset(, 1).Value) = 0 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] nRng = P
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, P)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] P
    nStr = ""
 [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
If Not nRng Is Nothing Then nRng.EntireRow.Delete '[COLOR="Green"][B][/B][/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[alocke]

Thanks for the lengthy response Mick! Works a charm! Need to get more comfortable with scripting dictionaries as they seem very useful in VBA!

 

[MickG]

You're very welcome
Thanks for the Feedback
Regrds Mick