VBA - Concatenate Match Offset Loop

MixedUpExcel

Board Regular
Joined
Apr 7, 2015
Messages
222
Office Version
  1. 365
Platform
  1. Windows
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:

Code:
{=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
 
Last edited:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Hi,

I've put the below code together which mostly does what I want.

If anyone sees this posts and can suggest something better, please let me know.

Code:
Sub test2()

Dim x As String
Dim y As String
Dim m As String


For a = 2 To 1400
For z = 11 To 500


x = Cells(a, 10)
y = Cells(1, z)


m = y & x


numRow = Application.Match(m, Range("c:c"), 0)


If IsError(numRow) = False Then
    Cells(a, z).Value = Range("d1").Offset(numRow - 1)
Else
    
   GoTo NEXTROW
   
End If


Next


NEXTROW:


Next


End Sub

Thanks.

Simon
 
Upvote 0
Do you want duplicates codes in K, L etc as you have shown, or just the unique values like


Excel 2013/2016
JKLMN
2AB123XY1XY4
3AB124XY2XY5
4AB125XY3XY6
5AB126XY4XY5XY1XY2
6AB127XY6XY3
7AB128XY1XY4
8AB129XY2XY5
9AB130XY3XY6
T
 
Upvote 0
Hi Fluff,

I hadn't even noticed that - I'd done that with the formula and dragged across (I think I must have missed a $ sign somewhere or something as it usually works ok (or so I think))

I've got the coding doing what I needed now, so won't need the formula now.

Thanks for letting me know though, it's worth checking to make sure it is only a simple error on my side of things.

Simon
 
Upvote 0
If you just want the unique values try
Code:
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
         .Offset(i, 1).Resize(, Dic(Ky).Count).Value = Dic(Ky).Keys
         i = i + 1
      Next Ky
   End With
End Sub
 
Upvote 0
Thanks Fluff,

I've tried running it but I'm not sure what I'm expecting it to do?

I've got my product codes in Column A / associated codes in Column B and the unique list of product codes in Column J.

When I run your code, nothing seems to happen and then after a while, I get the following message:

Run-time error '1004':
Application-defined or object defined error

Thanks.
 
Upvote 0
Firstly you don't need the list in col J, the macro will put them in for you.
Secondly when you get the error click debug, what line is highlighted?
 
Upvote 0
Hi Fluff,

Error appears to be against line:

Code:
.Offset(i, 1).Resize(, Dic(Ky).Count).Value = Dic(Ky).Keys


Thanks.
 
Last edited:
Upvote 0
Firstly you don't need the list in col J, the macro will put them in for you.
Secondly when you get the error click debug, what line is highlighted?

Hi Fluff,

Thank you for taking the time to create that piece of code for me.

A lot of that is beyond my current understanding but I'm more than happy to learn more.

I hadn't realised at first that your code was bypassing some of the processes I thought I need and speeding it up to such an amazingly quick pace.

Really appreciate it.

Thank you for your help again.

Simon


Edit:

If this makes any difference - this is from my actual sheet:

Column A and B have 162,820 rows

When I got the error message, it had put in the Product Code in Column J on Row 7570 BUT it hadn't put in the first Associated code into Cell K7570 (it just stopped there)

The Product Code in Cell J7570 first appears in Column A on Row 108431

I've put the above because I don't know if there are any limitations to the code you've provided me with regards to number of rows it can deal with etc.

Thanks.
 
Last edited:
Upvote 0
Clear column J & run this
Code:
Sub MixedUpExcelTest()
   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)
      Dic(Ary(i, 1)) = Dic(Ary(i, 1)) + 1
   Next i
   i = 0
   With Range("J" & Rows.Count).End(xlUp).Offset(1)
      For Each Ky In Dic.Keys
         .Offset(i).Resize(, 2).Value = Array(Ky, Dic(Ky))
         i = i + 1
      Next Ky
   End With
End Sub
Then check what the highest value in col L, what is it?
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top