VBA - Concatenate Match Offset Loop

[MixedUpExcel]

Hi,

Detail of data:

Column A has a list of product codes (of which there can be duplicates upto 5000 duplicates but in some cases, there may only be 1)
Column B has a list of associated product codes (there may also be duplicates as more than one of the products in Column A can be associated with the products in Column B) - I don't think the duplicate issue will come in to this though

I have a unique list of product codes from Column A and these are placed under a header in Column J

I have a number from 1 to 5000 as headers in Cell K1 going to the right ->>>

I want a VBA code which will take the product code from Cell J2 - find the corresponding code in Column A and return the product code next to it in Column B and put that code in Cell K2

As there will be duplicates, I want the code to then move to Cell L2 and look for the next instance in Column A where it finds the product code from Cell J2 (the second instance) and puts the result in Cell L2 and so on until it can't find any more products (Cell J2) in Column A

Then, it moves to Row 3, Column J and does the process again until it can't find any more of the Product Code (Cell J3) in Column A.

I will have potentially 40,000 Unique Codes in Column J

I have a formula which can do this but takes FAR TOO LONG to process.

This is my formula:

{=INDEX(Sheet1!$B$2:$B$20000, SMALL(IF($J2=Sheet1!$A$2:$A$20000, ROW(Sheet1!$B$2:$B$20000)-MIN(ROW(Sheet1!$B$2:$B$20000))+1, ""), COLUMN(A1)))}

This is an example table as described above:

[TABLE="width: 1074"]
<colgroup><col span="2"><col><col span="7"><col><col span="5"></colgroup><tbody>[TR]
[TD] [/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[TD]O[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Product[/TD]
[TD]Associated[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]Unique Product[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]AB123[/TD]
[TD]XY1[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB123[/TD]
[TD]XY1[/TD]
[TD]XY4[/TD]
[TD]XY1[/TD]
[TD]XY4[/TD]
[TD]#NUM![/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]AB124[/TD]
[TD]XY2[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB124[/TD]
[TD]XY2[/TD]
[TD]XY5[/TD]
[TD]XY2[/TD]
[TD]XY5[/TD]
[TD]#NUM![/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]AB125[/TD]
[TD]XY3[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB125[/TD]
[TD]XY3[/TD]
[TD]XY6[/TD]
[TD]XY3[/TD]
[TD]XY6[/TD]
[TD]#NUM![/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]AB126[/TD]
[TD]XY4[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB126[/TD]
[TD]XY4[/TD]
[TD]XY5[/TD]
[TD]XY1[/TD]
[TD]XY2[/TD]
[TD]XY4[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]AB126[/TD]
[TD]XY5[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB127[/TD]
[TD]XY6[/TD]
[TD]XY3[/TD]
[TD]XY6[/TD]
[TD]#NUM![/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]AB127[/TD]
[TD]XY6[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB128[/TD]
[TD]XY1[/TD]
[TD]XY4[/TD]
[TD]XY1[/TD]
[TD]#NUM![/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]AB128[/TD]
[TD]XY1[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB129[/TD]
[TD]XY2[/TD]
[TD]XY5[/TD]
[TD]XY2[/TD]
[TD]#NUM![/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]AB129[/TD]
[TD]XY2[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]AB130[/TD]
[TD]XY3[/TD]
[TD]XY6[/TD]
[TD]XY3[/TD]
[TD]#NUM![/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]AB130[/TD]
[TD]XY3[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]AB123[/TD]
[TD]XY4[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]AB124[/TD]
[TD]XY5[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]AB125[/TD]
[TD]XY6[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]AB126[/TD]
[TD]XY1[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]AB126[/TD]
[TD]XY2[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]AB127[/TD]
[TD]XY3[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]AB128[/TD]
[TD]XY4[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD]AB129[/TD]
[TD]XY5[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD]AB130[/TD]
[TD]XY6[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD]AB123[/TD]
[TD]XY1[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]21[/TD]
[TD]AB124[/TD]
[TD]XY2[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]22[/TD]
[TD]AB125[/TD]
[TD]XY3[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]23[/TD]
[TD]AB126[/TD]
[TD]XY4[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]24[/TD]
[TD]AB126[/TD]
[TD]XY5[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]25[/TD]
[TD]AB127[/TD]
[TD]XY6[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]26[/TD]
[TD]AB128[/TD]
[TD]XY1[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]27[/TD]
[TD]AB129[/TD]
[TD]XY2[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]28[/TD]
[TD]AB130[/TD]
[TD]XY3[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]29[/TD]
[TD]AB123[/TD]
[TD]XY4[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]30[/TD]
[TD]AB124[/TD]
[TD]XY5[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]31[/TD]
[TD]AB125[/TD]
[TD]XY6[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]32[/TD]
[TD]AB126[/TD]
[TD]XY1[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]


My thoughts were to possibly concatenate the unique codes in Column J with the header number (have an inserted Column at the start - a new Column A possibly) and using Countif eg. =Countif($A$2:A2,A2) in the new Column A - give me the number in the Count which I can concatenate in a new column and do a look up that way - or match / offset etc.

Is there any way to do the above or is there a better solution?

Thanks in advance.

Simon

 

[MixedUpExcel]

Hi,

The highest value is 18125 which coincidentally is the product code it stopped on last time. The next one is 2100 after 18125

I'm guessing that's because there aren't enough Columns to run this.

As it's one product code, is there a way to ignore any that fail (in this case it's only 1 but I may have other data to run this against which may come up against a similar problem)

Or do you have any suggestions to get round this?

Thanks again.

 

[Fluff]

How about

Sub MixedUpExcel()
   Dim Ary As Variant, Ky As Variant
   Dim Dic As Object
   Dim i As Long
   
   Ary = Range("A1").CurrentRegion.Value2
   
   Set Dic = CreateObject("scripting.dictionary")
   For i = 2 To UBound(Ary)
      If Not Dic.Exists(Ary(i, 1)) Then Dic.Add Ary(i, 1), CreateObject("scripting.dictionary")
      Dic(Ary(i, 1))(Ary(i, 2)) = Empty
   Next i
   i = 0
   With Range("J" & Rows.Count).End(xlUp).Offset(1)
      For Each Ky In Dic.Keys
         .Offset(i).Value = Ky
         If Dic(Ky).Count > 16370 Then
            .Offset(i, 1) = "Too many Products"
         Else
            .Offset(i, 1).Resize(, Dic(Ky).Count).Value = Dic(Ky).Keys
         End If
         i = i + 1
      Next Ky
   End With
End Sub

 

[MixedUpExcel]

Hi Fluff.

That worked brilliantly.

Nice touch putting 'Too many Products', so I don't miss any from the unique list.

Again,

I really appreciate the time you've put in today to help me out with this so quickly.

I'm now going to try and learn as much as I can about your code as I can see so many other places I can benefit from this.

Thank you again.

Simon

 

[Fluff]

You're welcome & thanks for the feedback.
Another thought if you add the line in red

         If Dic(Ky).Count > 16370 Then
            .Offset(i, 1) = "Too many Products"
           [COLOR=#ff0000] .Offset(i).Interior.Color = vbRed[/COLOR]
         Else

It will highlight the product that is a problem, making it a bit more obvious.

 

[MixedUpExcel]

You're welcome & thanks for the feedback.
Another thought if you add the line in red

         If Dic(Ky).Count > 16370 Then
            .Offset(i, 1) = "Too many Products"
           [COLOR=#ff0000] .Offset(i).Interior.Color = vbRed[/COLOR]
         Else

It will highlight the product that is a problem, making it a bit more obvious.

Thanks for the extra tip.. it's given me some more ideas as well.

Thanks.

 

[Fluff]

You're welcome