Match data and paste paste to row

quik80 · Mar 26, 2011

Hi there , im looking to have VBA do a number of things. I have 2 sheets on my workbook both of which contain very similar data. Column A on both sheets contain numbers, columns B - AH (the end is variable depending on number of days in the month) contains random pre-set letters. Im wanting excel to identify when the numbers in column A match and if they do, copy the data in columns B - (end) on sheet 2 and paste it to sheet 1 (at the end of the data in the matched row)

eg sheet 1
62 F F F
56 C C C

sheet 2
55 G G G
56 E G G
should end up looking like
sheet 1
55 G G G
56 C C C E G G
62 F F F
There is about 200 rows on each sheet, 98% of the time column A does contain the same data, the problem being, the data moves around so i cant do a direct copy paste. I also cant just sort and copy paste as sometimes one of the numbers isnt there so ... again ... it would be out of sync. By doing a =match i can find out the row number where the data is on the other sheet, i just dont know how to get excel to take that information and use it to paste. !!! Any help would be much appreciated.

Copy of the sheet located …. http://wikisend.com/download/968922/testing.xlsm

MickG · Mar 27, 2011

Try this:-
For Sheets 1 & 2.
Data starts "A1"

Code:

[COLOR="Navy"]Sub[/COLOR] MG27Mar29
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c
[COLOR="Navy"]Dim[/COLOR] Ac2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Tray
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 
With Sheets("sheet1") '[COLOR="Green"][B]sht1[/B][/COLOR]
   [COLOR="Navy"]Set[/COLOR] Rng1 = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
With Sheets("sheet2") '[COLOR="Green"][B]sht2[/B][/COLOR]
  [COLOR="Navy"]Set[/COLOR] Rng2 = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
    ray = Array(Rng1, Rng2)
        ReDim raydn(1 To Rng1.Count + Rng2.Count)
            [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] Ac = 0 To 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] dn [COLOR="Navy"]In[/COLOR] ray(Ac)
        [COLOR="Navy"]If[/COLOR] Not .Exists(dn.Value) [COLOR="Navy"]Then[/COLOR]
            Lst = ray(Ac).Cells(dn.Row, Columns.Count).End(xlToLeft).Column
            ReDim rayac(1 To Lst)
            n = n + 1
            raydn(n) = rayac
            .Add dn.Value, n
                [COLOR="Navy"]For[/COLOR] Ac2 = 1 To Lst
                    raydn(n)(Ac2) = dn(, Ac2)
                [COLOR="Navy"]Next[/COLOR] Ac2
        [COLOR="Navy"]Else[/COLOR]
            Lst = ray(Ac).Cells(dn.Row, Columns.Count).End(xlToLeft).Column
                Tray = raydn(.Item(dn.Value))
                    ReDim rayac(1 To Lst + UBound(raydn(.Item(dn.Value))) - 1)
                        raydn(.Item(dn.Value)) = rayac
                            c = 1
            [COLOR="Navy"]For[/COLOR] Ac2 = 1 To UBound(rayac)
                [COLOR="Navy"]If[/COLOR] Ac2 <= UBound(Tray) [COLOR="Navy"]Then[/COLOR]
                    raydn(.Item(dn.Value))(Ac2) = Tray(Ac2)
                [COLOR="Navy"]Else[/COLOR]
                    c = c + 1
                    raydn(.Item(dn.Value))(Ac2) = dn(, c)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Ac2
        [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] dn
[COLOR="Navy"]Next[/COLOR] Ac
'[COLOR="Green"][B][/B][/COLOR]
Range("A1").CurrentRegion.ClearContents
[COLOR="Navy"]For[/COLOR] Rw = 1 To .Count
    [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(raydn(Rw))
        Cells(Rw, Ac) = raydn(Rw)(Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
 [COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Match data and paste paste to row

quik80

New Member

Excel Facts

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

Match data and paste paste to row

quik80

New Member

Excel Facts

MickG

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock