Sorting Column B to match Column A

[JK2012]

Hi all,

I'd like to start out by saying that I am new here, so I apologize if I am rusty with the rules.

Anyways I am trying to write a code in Excel 2010 that does the following:

Columns A and B contain all of the same values, but they are in different orders, and neither of them are in numerical order so I cannot use a sort. I want the values in column B to line up/match the values of column A.

Example:
A B
1 1
4 2
3 3
2 4
5 8
6 5
7 6
8 7
9 9

Solution:
A B
1 1
4 4
3 3
2 2
5 5
6 6
7 7
8 8
9 9

Any help will be greatly appreciated.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG03Nov19
'[COLOR="Green"][B]Align Data in columns "A & B"[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] RngA [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oval, oMax
[COLOR="Navy"]Dim[/COLOR] RngB [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ColA, ColB
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Set[/COLOR] RngA = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]Set[/COLOR] RngB = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
        oMax = Application.max(RngA.Count, RngB.Count)
            [COLOR="Navy"]Set[/COLOR] RngA = Range("A2").Resize(oMax)
                ReDim ray(1 To RngA.Count * 2, 1 To 2)
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] RngA
            [COLOR="Navy"]For[/COLOR] col = 1 To 2
                oval = IIf(col = 1, Dn, Dn.Offset(, 1))
                [COLOR="Navy"]If[/COLOR] Not .Exists(oval) [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]If[/COLOR] col = 1 [COLOR="Navy"]Then[/COLOR]
                        ColA = 1: ColB = 0
                    [COLOR="Navy"]Else[/COLOR]
                        ColB = 1: ColA = 0
                    [COLOR="Navy"]End[/COLOR] If
                    .Add oval, Array(ColA, ColB, 1)
                [COLOR="Navy"]Else[/COLOR]
                    Q = .Item(oval)
                    [COLOR="Navy"]If[/COLOR] col = 1 [COLOR="Navy"]Then[/COLOR]
                        Q(0) = Q(0) + 1
                    [COLOR="Navy"]ElseIf[/COLOR] col = 2 [COLOR="Navy"]Then[/COLOR]
                        Q(1) = Q(1) + 1
                    [COLOR="Navy"]End[/COLOR] If
                    Q(2) = Application.max(Q(0), Q(1))
                    .Item(oval) = Q
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] col
        [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Bc [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .Keys
    [COLOR="Navy"]For[/COLOR] n = 1 To .Item(k)(2)
        rw = rw + 1
        Ac = IIf(n > .Item(k)(0), "", k)
        Bc = IIf(n > .Item(k)(1), "", k)
        ray(rw, 1) = Ac
        ray(rw, 2) = Bc
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] k
Range("A2").Resize(rw, 2) = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[JK2012]

Thank you Mick. Works perfectly, and you saved me a lot of time and headaches.