How to find the earliest and latest date when multiple criteria is met.

[Plumpychunks]

Hi,

Please help.

I have a sheet of data that is outputted from an external source, see below:

Vehicle Reg

AxleType

Axle

Position

Dimension

New/Retread

Brand

Pattern

Event

Mileage

OTD

Date

RTD

Removal

Regrooved

abc123

Drive

3

L

295/80R22.5

New

GOODYEAR

KMAX

Fitment

10

24

1.1.2016

24

3

N

abc123

Drive

3

L

295/80R22.5

New

GOODYEAR

KMAX

Exam

120000

24

31.12.2017

6

3

N

abc123

Drive

3

L

295/80R22.5

New

GOODYEAR

KMAX

Removal

123321

24

1.1.2018

4

3

N

789zyx

Carry

3

R

385/65R22.5

New

PIRELLI

AA1

Fitment

10

22

1.1.2012

22

3

N

<tbody>
</tbody>

I would like some VBA to extract the rows that contain the earliest and latest date when columns A,B,C,D,E,G & H are all the same.

I can find methods to extract earliest and latest dates but none that can do it based 7 criteria.

All help would be greatly appreciated.

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG01Mar38
[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] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    txt = Join(Application.Index(Dn.Resize(, 8).Value, 0, Array(1, 2, 3, 4, 5, 7, 8)))
    [COLOR="Navy"]If[/COLOR] Not .Exists(txt) [COLOR="Navy"]Then[/COLOR]
        .Add txt, Array(Dn.Offset(, 11), Dn.Offset(, 11))
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(txt)
          [COLOR="Navy"]If[/COLOR] Dn.Offset(, 11).Value < Q(0) [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Q(0) = Dn.Offset(, 11)
          [COLOR="Navy"]If[/COLOR] Dn.Offset(, 11).Value > Q(1) [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Q(1) = Dn.Offset(, 11)
        .Item(txt) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]If[/COLOR] Not .Item(K)(0) = .Item(K)(1) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Sheets("sheet2").Cells(c, 1).Resize(, 15).Value = .Item(K)(0).Offset(, -11).Resize(, 15).Value
        c = c + 1
        Sheets("sheet2").Cells(c, 1).Resize(, 15).Value = .Item(K)(1).Offset(, -11).Resize(, 15).Value
    [COLOR="Navy"]ElseIf[/COLOR] .Item(K)(0) = .Item(K)(1) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Sheets("sheet2").Cells(c, 1).Resize(, 15).Value = .Item(K)(0).Offset(, -11).Resize(, 15).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Plumpychunks]

That IS magic!

Thank you, that has saved me a heap of time.

 

[MickG]

You're welcome