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


[TABLE="width: 500"]
<tbody>[TR]
[TD]PARTNO1[/TD]
[TD]Hyundai[/TD]
[TD]Accent[/TD]
[TD]01/01/94[/TD]
[TD]31/12/99[/TD]
[/TR]
[TR]
[TD]PARTNO1[/TD]
[TD]Hyundai[/TD]
[TD]i30[/TD]
[TD]01/01/98[/TD]
[TD]31/12/16[/TD]
[/TR]
[TR]
[TD]PARTNO1[/TD]
[TD]Hyundai[/TD]
[TD]i40[/TD]
[TD]01/01/99[/TD]
[TD]31/12/17[/TD]
[/TR]
[TR]
[TD]PARTNO2[/TD]
[TD]Hyundai[/TD]
[TD]Accent[/TD]
[TD]01/01/94[/TD]
[TD]31/12/99[/TD]
[/TR]
[TR]
[TD]PARTNO2[/TD]
[TD]Subaru[/TD]
[TD]Impreza[/TD]
[TD]01/01/93[/TD]
[TD]31/12/98[/TD]
[/TR]
[TR]
[TD]PARTNO2[/TD]
[TD]Toyota[/TD]
[TD]Celica[/TD]
[TD]01/01/95[/TD]
[TD]31/12/01[/TD]
[/TR]
[TR]
[TD]PARTNO3[/TD]
[TD]Toyota[/TD]
[TD]Celica[/TD]
[TD]01/08/94[/TD]
[TD]31/05/02[/TD]
[/TR]
[TR]
[TD]PARTNO3[/TD]
[TD]Toyota[/TD]
[TD]MR2[/TD]
[TD]01/01/91[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


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:

[TABLE="width: 500"]
<tbody>[TR]
[TD]PARTNO1[/TD]
[TD]Hyundai Accent, i30, i40 01/94>12/17[/TD]
[/TR]
[TR]
[TD]PARTNO2[/TD]
[TD]Hyundai Accent 01/94>12/99. Subaru Impreza 01/93>12/98[/TD]
[/TR]
[TR]
[TD]PARTNO2[/TD]
[TD]Toyota Celica 08/94>05/02, MR2 01/91>[/TD]
[/TR]
</tbody>[/TABLE]


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:

[TABLE="width: 500"]
<tbody>[TR]
[TD](Column A)[/TD]
[TD](Column B)[/TD]
[TD](Column C)[/TD]
[/TR]
[TR]
[TD]PARTNO1[/TD]
[TD]Hyundai Accent, i30, i40[/TD]
[TD]01/94>12/17[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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:

[TABLE="width: 500"]
<tbody>[TR]
[TD]PARTNO2[/TD]
[TD]Hyundai Accent. Subaru Impreza. Toyota Celica[/TD]
[TD]01/94>12/99 01/93>12/98 01/95>12/01[/TD]
[/TR]
</tbody>[/TABLE]


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