Match and sort different sized data sets

[John Caines]

Hello All.
I'm trying to match a column of data to another column of data (IE Sort).
But there's a catch!
The data sets are different lengths and I have another column that needs to be sorted/moved at the same time.

Here's an example sheet so it starts to make sense (I hope!)

Book1
	A	B	C	D	E	F	G	H	I	J
1	original list		list to match	data with list to match		Result I'm looking for is	original list		list to match	data with list to match
2	cat		fox	golden brown			cat		cat	white
3	dog		cat	white			dog		dog	black
4	pig		sheep	fat			pig
5	elephant		elephant	big			elephant		elephant	big
6	bird		dog	black			bird
7	sheep						sheep		sheep	fat
8	ant						ant
9	cow						cow
10									fox	golden brown
Sheet1

Basically in Column A I have my Original list. So all sorted data needs to be adjusted to match this column. Column A data doesn't move, never needs to be sorted.
Col C is the column that needs to move to match column A data , so these cells line up on the same matching rows as the data in col A
Col D is data LOCKED to column C
So if a cell in column C moves, then the same cell of data that was on the same row as Col D moves with it

So Column G:J is how the data cells should end up
I left COL B blank as I was thinking a formula would need to go in there?
But if its easier to delete COLB and move the formula to a different Column, then no problem.

I hope the above makes sense.
My issue here is,
I've been googling etc for the solution, but I always seem to find solutions where the data sets are the same size, or don't mention more than 1 column to move and sort.
And my Col A might have a few 100 more rows of data than Col C & D etc

Hope someone can help me out here and it all makes sense

Many thanks in advance
I really hope someone can work this 1 out,
Really done my head in this 1 to be honest with you! LOL
Best Regards
John C

 

[Fluff]

@Fluff, would a dictionary object work for this using row numbers as a key?

It's possible, but I would use the values in col A as the key & the row number as the item, although that won't work if there can be duplicates.

I'll gladly sent a link to my sheet, (It will be a dropbox link)

In future please do not this, as it is against board rules. All communication (including sharing files) should be kept on the board. Thanks

 

[John Caines]

Hi Fluff,
Very sorry,
I certainly don't want to break any rules here.

I know it is kind of shunned upon PM'ing contributors, I totally get this.
I did try to contact you as you are a moderator explaining the situation.
But jasonb75 did say it was ok to PM him as data is a bit sensitive to display publicly, and he just wanted to see why his solution didn't work on my sheet

So, sorry again Fluff, unintentional as in trying to break rules cause a problem.
Feel quite guilty now, bad, like I've done something really wrong.

Very sorry
Best regards
John C

 

[Fluff]

It's not a major problem & I can appreciate why you did it, especially as you have a working solution.

Would you be interested in a VBA solution to sort the actual data, rather than having two new columns?
If so can you have duplicate values in either cols A or C?

 

[John Caines]

Hi Fluff!
Many thanks again for your reply.
You ask, would I be interested in a VBA solution?
Yes!! very much so. This would be amazing!

I really could use this sheet in many situations, it would be really useful.

I do have a couple of ideas for it though, to make it super flexible, but not sure if it's possible.

Firstly though, If you could get the same result in a VBA solution from what you have now then that would be great.
But maybe,, if possible, could this be tweaked slightly in a vba solution?

Here's my idea.
You are always trying to sort from Col A (from A2 down).
But...what if also

Col A contained duplicates?​

Col A had some blank cells? (This is a common 1 for me)​

​

Having a working VBA solution that also gets over blank cells in COL A would be really handy indeed!

EXAMPLE:
So what if I click on a macro button and a pop up appears and said something like, "Choose COL A Range" So I would have to input A2:A613 for example
This would them mean it looks at that range of data even if there are blanks or duplicates

(thinking aloud, maybe on the pop up it might also have a tick box or something where it might say "Does Col A contain Duplicates?" and I could select yes or no (Just thinking aloud, might make the VBA formula run better if the formula already knows this?)

Then you could also have a selector which would say "What columns to match and their ranges?"
And I could just type in (if it was only Column C),,, "C2:C512"
Or if it was 2 columns (As I have now) I would type in "C2:C512 &D2:D512"
Maybe this might also help the VBA formula to run,,,
#I'm thinking only to do this, pre-select ranges as possibly these might help the formula to include blank cells.

I know the above is a big ask, but I was just trying to picture like the ultimate VBA solution for this.
So this basically means you can;

1. select the data range for the original list
2. select the columns that need to be matched
3. select their ranges,

Not much to ask for Fluff!
If this is possible, it would be amazingly useful.
If not, no worries, as you have kindly provided a working excel formula that is really useful to me as is.

Many thanks again for your reply Fluff.
Best regards
John C

​

 

[Fluff]

This will ignore blanks, but if you have duplicates in col A the value from C will go on the 2nd match

Sub JohnC()
   Dim Cl As Range
   Dim Ary As Variant
   Dim r As Long, nr As Long
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         nr = nr + 1
         If Cl.Value <> "" Then .Item(Cl.Value) = Cl.Row - 1
      Next Cl
      r = Range("C" & Rows.Count).End(xlUp).Row
      ReDim Ary(1 To .Count + nr, 1 To 2)
      nr = nr + 1
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            Ary(.Item(Cl.Value), 1) = Cl.Value
            Ary(.Item(Cl.Value), 2) = Cl.Offset(, 1).Value
         Else
            Ary(nr, 1) = Cl.Value
            Ary(nr, 2) = Cl.Offset(, 1).Value
            nr = nr + 1
         End If
      Next Cl
   End With
   Range("C2").Resize(nr, 2).Value = Ary
End Sub

 

[John Caines]

Hi Fluff!
Many thanks for getting back to me on a VBA solution for this.

I've just tried it out, works brilliant! Really quick / amazing stuff!!

Yes, I see what you mean about a duplicate from COL A the value from C will go to the second match.

This is great
Whenever I see code like this you've written I think of a guy called Jindon that helped me with some code many years ago on this forum,,, all looks really alien! LOL
I did just quickly Google With CreateObject("scripting.dictionary)
I wish I hadn't! LOL,,, all very deep and very advanced.

Many thanks again Fluff for your help with this.
It will come in handy for sure.

Have a great afternoon / evening.
Best regards
A very grateful

John C

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Fluff]

Thought I'd have some fun.
This will handle duplicates and also handle more "cats" in col C than col A

Sub JohnC()
   Dim Cl As Range
   Dim Ary As Variant, Sp As Variant
   Dim r As Long, nr As Long
   
   With CreateObject("scripting.dictionary")
      .comparemode = 1
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         nr = nr + 1
         If Cl.Value <> "" Then
            If Not .Exists(Cl.Value) Then
               .Add Cl.Value, Cl.Row - 1
            Else
               .Item(Cl.Value) = .Item(Cl.Value) & "," & Cl.Row - 1
            End If
         End If
      Next Cl
      r = Range("C" & Rows.Count).End(xlUp).Row
      ReDim Ary(1 To .Count + nr, 1 To 2)
      nr = nr + 1
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            r = Split(.Item(Cl.Value), ",")(0)
            Ary(r, 1) = Cl.Value
            Ary(r, 2) = Cl.Offset(, 1).Value
            If InStr(1, .Item(Cl.Value), ",") > 0 Then
               .Item(Cl.Value) = Split(.Item(Cl.Value), ",", 2)(1)
            Else
               .Remove Cl.Value
            End If
         Else
            Ary(nr, 1) = Cl.Value
            Ary(nr, 2) = Cl.Offset(, 1).Value
            nr = nr + 1
         End If
      Next Cl
   End With
   Range("f2").Resize(nr, 2).Value = Ary
End Sub

 

[jasonb75]

Hi, John

Looking over the file I found a couple of reasons why it wasn't working, there were a couple of errors in your named range references. That is partly my error, I should have mentioned that the sheet names would need to be changed to match the actual location of the data. I also noticed that you had changed some of the row and column references in the named ranges which means that they would not have lined up with the data, even with the correct sheet names.

After correcting the named ranges, I noticed that the results at the top were correct but started to drift as you scroll down the sheet.

I noticed that there are some duplicate records in column C, which I believe @Fluff has also observed and subsequently addressed with the vba solution above. This is something that I do not believe can be handled practically with a formula, but that would depend on the desired outcome (i.e. how you would want those duplicates displayed in the sheet). I may well have another look at it at some point just to see if it can be done, but personally I would use the vba approach for something this complex.

Using the example from post 1 with a duplicate record to demonstrate the problem, you can see that 'Cat - White' occupies the matching row for 'Cat' in the original list, leaving nowhere for 'Cat - Black' to be fitted in.

Book1 (version 1).xlsb
	A	B	C	D	E
1	original list		list to match	data with list to match	Sort order
2	cat		cat	white	1
3	dog		cat	black	1
4	pig		dog	black	2
5	elephant				3
6	bird		elephant	big	4
7	sheep				5
8	ant		sheep	fat	6
9	cow				7
10	dog				8
11			fox	golden brown	10
Sheet6

Cell Formulas
Range	Formula
E2:E11	E2	=IFERROR(IFERROR(MATCH(C2,Original,0),IF(C2<>"",MAX(COUNTA(Original),E$1:E1)+1,AGGREGATE(15,6,ROW(Original)/ISNA(MATCH(Original,Match,0)),COUNTBLANK(C$1:C1)+1)-1)),"")

 

[Fluff]

Update to the code in post#18, there were a couple of potential bugs

Sub JohnC()
   Dim Cl As Range
   Dim Ary As Variant, Sp As Variant
   Dim r As Long, nr As Long
   
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         nr = nr + 1
         .Item(Cl.Value) = .Item(Cl.Value) & Cl.Row - 1 & ","
      Next Cl
      r = Range("C" & Rows.Count).End(xlUp).Row
      ReDim Ary(1 To r + nr, 1 To 2)
      nr = nr + 1
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         If Cl.Value <> "" And .Exists(Cl.Value) Then
            Sp = Split(.Item(Cl.Value), ",")
            r = Sp(0)
            Ary(r, 1) = Cl.Value
            Ary(r, 2) = Cl.Offset(, 1).Value
            If UBound(Sp) > 1 Then
               .Item(Cl.Value) = Split(.Item(Cl.Value), ",", 2)(1)
            Else
               .Remove Cl.Value
            End If
         ElseIf Cl.Value <> "" Then
            Ary(nr, 1) = Cl.Value
            Ary(nr, 2) = Cl.Offset(, 1).Value
            nr = nr + 1
         End If
      Next Cl
   End With
   Range("f2").Resize(nr, 2).Value = Ary
End Sub