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
<tbody>
</tbody>
My original code which concentrates on Columns A, B and C ensures only one unique part number per line.
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:
<tbody>
</tbody>
Any help would be very much appreciated.
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.
Code:
'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.