Lowest and Highest Date based on value in another column

[Steve1977]

I'm revisiting my file and wondered if it's possible to tweak and to apply a minimum and maximum date. Basically, this is my data

PARTNO1	Hyundai	Accent	01/01/94	31/12/99
PARTNO1	Hyundai	i30	01/01/98	31/12/16
PARTNO1	Hyundai	i40	01/01/99	31/12/17
PARTNO2	Hyundai	Accent	01/01/94	31/12/99
PARTNO2	Subaru	Impreza	01/01/93	31/12/98
PARTNO2	Toyota	Celica	01/01/95	31/12/01
PARTNO3	Toyota	Celica	01/08/94	31/05/02
PARTNO3	Toyota	MR2	01/01/91

<tbody>
</tbody>

My original code which concentrates on Columns A, B and C ensures only one unique part number per line.

'Removes second column
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
 
' Removes Duplicates
    Columns("A:C").Select
    ActiveSheet.Range("$A$1:$C$1000000").RemoveDuplicates Columns:=Array(1, 3), _
        Header:=xlNo
 
' Removes Brackets
    Cells.Replace What:=" (*)", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
 
 
 
Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant, K As Variant
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, CreateObject("scripting.dictionary")
         If Not Dic(Cl.Value).Exists(Cl.Offset(, 1).Value) Then
            Dic(Cl.Value).Add (Cl.Offset(, 1).Value), Cl.Offset(, 2).Value
         Else
            Dic(Cl.Value)(Cl.Offset(, 1).Value) = Dic(Cl.Value)(Cl.Offset(, 1).Value) & ", " & Cl.Offset(, 2).Value
         End If
      Next Cl
   End With
   With Sheets("Sheet2")
            For Each Ky In Dic.Keys
         With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Value = Ky
            For Each K In Dic(Ky)
               .Offset(, 1).Value = .Offset(, 1).Value & ". " & K & " " & Dic(Ky)(K)
            Next K
            .Offset(, 1).Value = Replace(.Offset(, 1).Value, ". ", "", 1, 1)
         End With
      Next Ky
   End With
End Sub

But how could I get it to understand the value in Column B to ensure it shows the lowest and highest date? So the output would be as follows:

PARTNO1	Hyundai Accent, i30, i40 01/94>12/17
PARTNO2	Hyundai Accent 01/94>12/99. Subaru Impreza 01/93>12/98
PARTNO2	Toyota Celica 08/94>05/02, MR2 01/91>

<tbody>
</tbody>

Any help would be very much appreciated.

 

[Fluff]

How about

Sub Steve1977()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant, K As Variant, Tmp As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("list")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, CreateObject("scripting.dictionary")
         If Not Dic(Cl.Value).Exists(Cl.Offset(, 1).Value) Then
            Dic(Cl.Value).Add (Cl.Offset(, 1).Value), Array(Cl.Offset(, 2).Value, Cl.Offset(, 3).Value, Cl.Offset(, 4).Value)
         Else
            Tmp = Dic(Cl.Value)(Cl.Offset(, 1).Value)
            Tmp(0) = Tmp(0) & ", " & Cl.Offset(, 2).Value
            If Tmp(1) > Cl.Offset(, 3) Then Tmp(1) = Cl.Offset(, 3).Value
            If Tmp(2) < Cl.Offset(, 4) Then Tmp(2) = Cl.Offset(, 4).Value
            Dic(Cl.Value)(Cl.Offset(, 1).Value) = Tmp
         End If
      Next Cl
   End With
   With Sheets("Sheet3")
      For Each Ky In Dic.Keys
         With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Value = Ky
            For Each K In Dic(Ky)
               .Offset(, 1).Value = .Offset(, 1).Value & ". " & K & " " & Dic(Ky)(K)(0) & " " & Format(Dic(Ky)(K)(1), "mm/yy") & ">" & Format(Dic(Ky)(K)(2), "mm/yy")
            Next K
            .Offset(, 1).Value = Replace(.Offset(, 1).Value, ". ", "", 1, 1)
         End With
      Next Ky
   End With
End Sub

 

[Steve1977]

Absolute legend! This works superbly, thank you. Will try and dechiper the code to get a better understanding of it

 

[Steve1977]

Actually, just one little question if possible...how would I put the actual dates in a seperate (third) column?

 

[Fluff]

How would you like it to look?

 

[Steve1977]

Thank you for the quick reply

Basically like this:

(Column A)	(Column B)	(Column C)
PARTNO1	Hyundai Accent, i30, i40	01/94>12/17

<tbody>
</tbody>

Actually, thinking out loud...this wouldn't be possible when having two or more different Manufacturers in Column B as I want the date specific to the Manufacturer.

I suppose if the date is in a different column, then a different Manufacturer would have to be on the next line down to accomodate the date.
If you could advise how the date could go into Column C and I'll see if I can adapt the previous code you kindly posted on the other thread which put different manufacturers on each line.

 

[Fluff]

How about

Sub Steve1977()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant, K As Variant, Tmp As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("list")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Not Dic.Exists(Cl.Value) Then Dic.Add Cl.Value, CreateObject("scripting.dictionary")
         If Not Dic(Cl.Value).Exists(Cl.Offset(, 1).Value) Then
            Dic(Cl.Value).Add (Cl.Offset(, 1).Value), Array(Cl.Offset(, 2).Value, Cl.Offset(, 3).Value, Cl.Offset(, 4).Value)
         Else
            Tmp = Dic(Cl.Value)(Cl.Offset(, 1).Value)
            Tmp(0) = Tmp(0) & ", " & Cl.Offset(, 2).Value
            If Tmp(1) > Cl.Offset(, 3) Then Tmp(1) = Cl.Offset(, 3).Value
            If Tmp(2) < Cl.Offset(, 4) Then Tmp(2) = Cl.Offset(, 4).Value
            Dic(Cl.Value)(Cl.Offset(, 1).Value) = Tmp
         End If
      Next Cl
   End With
   With Sheets("Sheet3")
      For Each Ky In Dic.Keys
         With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Value = Ky
            For Each K In Dic(Ky)
               .Offset(, 1).Value = .Offset(, 1).Value & ". " & K & " " & Dic(Ky)(K)(0)
               .Offset(, 2).Value = .Offset(, 2).Value & " " & Format(Dic(Ky)(K)(1), "mm/yy") & ">" & Format(Dic(Ky)(K)(2), "mm/yy")
            Next K
            .Offset(, 1).Value = Replace(.Offset(, 1).Value, ". ", "", 1, 1)
            .Offset(, 2).Value = Replace(.Offset(, 2).Value, " ", "", 1, 1)
         End With
      Next Ky
   End With
End Sub

 

[Steve1977]

Thank you Fluff

It's superb in that it now puts it into a seperate column but the output when there's more than one manufacturer is as follows:

PARTNO2

Hyundai Accent. Subaru Impreza. Toyota Celica

01/94>12/99 01/93>12/98 01/95>12/01

<tbody>
</tbody>

So what I'm going to do is adapt your code where it put manufacturers on different lines and then include the bit which will put the date in a seperate column.
Doing it this way will keep me learning - hopefully! lol

 

[Fluff]

You're welcome & thanks for the feedback