[color=darkblue]Option[/color] [color=darkblue]Explicit[/color]
[color=darkblue]Sub[/color] ConcatenateData()
[color=green]' Scripting a Runtime "Dictionary" Here just a convinient quick way to assign a unique item MS___ to a unique key 1 2 3 etc.[/color]
[color=green]'--requires library reference to MS Scripting Runtime (Early Binding)[/color]
[color=green]' Tools>>References>>scroll down and check the box next to Microsoft Scripting Runtime[/color]
[color=green]' ..Or crashes at next line.....[/color]
[color=green]' Dim dicLookupTable As Scripting.Dictionary 'Data held with a unique "Key" or Part Number.[/color]
[color=green]' Set dicLookupTable = New Scripting.Dictionary[/color]
[color=green]' The next two lines are an alternative called Late binding.[/color]
[color=darkblue]Dim[/color] dicLookupTable [color=darkblue]As[/color] [color=darkblue]Object[/color]
[color=darkblue]Set[/color] dicLookupTable = CreateObject("Scripting.Dictionary") [color=green]'a place to store MS001,MS002 etc. as unique items with a "key" 1, 2 etc.[/color]
[color=darkblue]Dim[/color] wks1 [color=darkblue]As[/color] Worksheet, wks2 [color=darkblue]As[/color] Worksheet [color=green]' Give Abbreviations all properties and method of Object Worksheet[/color]
[color=darkblue]Set[/color] wks1 = Worksheets("Sheet1")
[color=darkblue]Set[/color] wks2 = Worksheets("Sheet2")
[color=darkblue]Let[/color] dicLookupTable.CompareMode = vbTextCompare
[color=darkblue]Dim[/color] Inary() [color=darkblue]As[/color] [color=darkblue]Variant[/color], Oaray() [color=darkblue]As[/color] [color=darkblue]Variant[/color] [color=green]'Input and Output arrays there values can be Variant type: anything (within reason)[/color]
[color=darkblue]Dim[/color] ConcanString [color=darkblue]As[/color] String [color=green]'Each line to go in column 2 of output[/color]
[color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], ORow [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]' number for Row count, Output Row Number[/color]
[color=darkblue]Dim[/color] LDRow [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'last Input Data Row[/color]
LDRow = wks1.Cells(Rows.Count, 1).End(xlUp).Row [color=green]'Find last row column 1, set by the C's[/color]
Inary = wks1.Range(wks1.Cells(1, 1), wks1.Cells(LDRow, 2)).Value [color=green]' "Capture" Input data in an array in one go[/color]
[color=darkblue]ReDim[/color] Oaray(1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](Inary, 1), 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](Inary, 2)) [color=green]'Output Array is much too big.. as big as if only unique values in column 1[/color]
[color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](Inary, 1) [color=green]'Going along the rows to upper bound of Input array row[/color]
[color=darkblue]If[/color] dicLookupTable.Exists(Inary(i, 1)) [color=darkblue]Then[/color] [color=green]'If we have already made an entry at this point in the dictionary so - want to concatenate.[/color]
ConcanString = ConcanString & Inary(i, 2) & " / "
Oaray(ORow, 2) = ConcanString
[color=darkblue]Else[/color] [color=green]'Assign a new unique value[/color]
ORow = ORow + 1 [color=green]'New Row for Output[/color]
dicLookupTable.Item((Inary(i, 1))) = ORow [color=green]'Put an item in the dictionary the item is in the (), j is the count or unique "key"[/color]
Oaray(ORow, 1) = Inary(i, 1) [color=green]'Put unique row number in first colum of output array[/color]
ConcanString = Inary(i, 2) & " / " [color=green]'First concantanated number for this unique row[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]Next[/color] i
[color=darkblue]Let[/color] wks2.Cells(1, 1).Resize(UBound(Oaray, 1), [color=darkblue]UBound[/color](Oaray, 2)).Value = Oaray [color=green]'Resize Output Range to otput array and make it equal to output Array[/color]
wks2.Columns(2).Resize(, UBound(Oaray, 2)).AutoFit
[color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] wks2.Cells(Rows.Count, 1).End(xlUp).Row [color=green]' For Output Rows[/color]
[color=darkblue]Let[/color] wks2.Cells(i, 2).Value = Left(wks2.Cells(i, 2).Value, Len(wks2.Cells(i, 2).Value) - 3) [color=green]'Strip off last /[/color]
[color=darkblue]Next[/color] i
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'ConcatenateData()[/color]