Match & Sort Same Vertical Data Onto One Row

Justijb

New Member
Joined
Aug 16, 2016
Messages
43
Good Morning Fellow Excel Experts,

Per usual - a thanks to everyone who contributes to this forum! What would the macro be to sort on column A / row 1 (Last Name, First Name), data through [column B:column Q] then find that same name in multiple worksheets (tabs) and then place that same name from the different tabs onto row 1 of the original worksheet after column q / row 1. Then complete that step through the entire workbook.

Any assistance would greatly be appreciated.

-J
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Bump. I've labeled the data as current state and desired state. There are around 6k rows of data with the column a being the
unique identifier (Last Name, First Name) each record may have more than one or just one, maximum of 5-6 rows per unique name.
There is data in columns B through column P. If the name matches on column a, the next row would need to be moved up to the matching
record row and pasted starting on column q, more than two records pasted on the same row, after the two original records.

Current State
Namedateactiondatadatanumberscodeorgpositioncodenumtypetype1positin typefromtocomment
Last Name, First Namexx/xx/xxxxwordsdatadata1897689890wordswordsx0x0wordswordsxx-01-21blankblankwords & numbers
Last Name, First Namexx/xx/xxxxwordsdatadata1897689890wordswordsx0x1wordswordsxx-01-22blankblankwords & numbers
Last Name1, First Name1xx/xx/xxxxwordsdatadata1897689890wordswordsx0x2wordswordsxx-01-23blankblankwords & numbers
Last Name1, First Name1xx/xx/xxxxwordsdatadata1897689890wordswordsx0x3wordswordsxx-01-24blankblankwords & numbers
Last Name1, First Name1xx/xx/xxxxwordsdatadata1897689890wordswordsx0x4wordswordsxx-01-25blankblankwords & numbers
Last Name2, First Name2xx/xx/xxxxwordsdatadata1897689890wordswordsx0x5wordswordsxx-01-26blankblankwords & numbers
Last Name2, First Name2xx/xx/xxxxwordsdatadata1897689890wordswordsx0x6wordswordsxx-01-27blankblankwords & numbers
Last Name3, First Name3xx/xx/xxxxwordsdatadata1897689890wordswordsx0x7wordswordsxx-01-28blankblankwords & numbers
Last Name4, First Name4xx/xx/xxxxwordsdatadata1897689890wordswordsx0x8wordswordsxx-01-29blankblankwords & numbers
Last Name4, First Name4xx/xx/xxxxwordsdatadata1897689890wordswordsx0x9wordswordsxx-01-30blankblankwords & numbers
Desired State
Namedateactiondatadatanumberscodeorgpositioncodenumtypetype1positin typefromtocommentNamedateactiondatadatanumberscodeorgpositioncodenumtypetype1positin typefromtocommentNamedateactiondatadatanumberscodeorgpositioncodenumtypetype1positin typefromtocomment
Last Name, First Namexx/xx/xxxxwordsdatadata1897689890wordswordsx0x0wordswordsxx-01-21blankblankwords & numbers Last Name, First Namexx/xx/xxxxwordsdatadata1897689890wordswordsx0x1wordswordsxx-01-22blankblankwords & numbers
Last Name1, First Name1xx/xx/xxxxwordsdatadata1897689890wordswordsx0x2wordswordsxx-01-23blankblankwords & numbers Last Name1, First Name1xx/xx/xxxxwordsdatadata1897689890wordswordsx0x3wordswordsxx-01-24blankblankwords & numbers Last Name1, First Name1xx/xx/xxxxwordsdatadata1#wordswordsx0x4wordswordsxx-01-25blankblankwords & numbers
Last Name2, First Name2xx/xx/xxxxwordsdatadata1897689890wordswordsx0x5wordswordsxx-01-26blankblankwords & numbers Last Name2, First Name2xx/xx/xxxxwordsdatadata1897689890wordswordsx0x6wordswordsxx-01-27blankblankwords & numbers
Last Name3, First Name3xx/xx/xxxxwordsdatadata1897689890wordswordsx0x7wordswordsxx-01-28blankblankwords & numbers
Last Name4, First Name4xx/xx/xxxxwordsdatadata1897689890wordswordsx0x8wordswordsxx-01-29blankblankwords & numbers Last Name4, First Name4xx/xx/xxxxwordsdatadata1897689890wordswordsx0x9wordswordsxx-01-30blankblankwords & numbers

<colgroup><col><col><col><col span="2"><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col span="2"><col><col><col span="2"><col><col span="2"><col><col span="2"><col><col><col><col><col><col span="2"><col><col><col span="2"><col><col span="2"><col><col><col></colgroup><tbody>
</tbody>
 
Upvote 0
Based on post# 2 , try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG08Aug22
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Dn, 1)
    [COLOR="Navy"]Else[/COLOR]
    Q = .Item(Dn.Value)
        Q(1) = Q(1) + 16
        Rng(1).Resize(, 16).Copy Cells(1, Q(1))
        Dn.Resize(, 16).Copy Cells(Q(0).Row, Q(1))
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Based on post# 2 , try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG08Aug22
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Q [COLOR=Navy]As[/COLOR] Variant, nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        .Add Dn.Value, Array(Dn, 1)
    [COLOR=Navy]Else[/COLOR]
    Q = .Item(Dn.Value)
        Q(1) = Q(1) + 16
        Rng(1).Resize(, 16).Copy Cells(1, Q(1))
        Dn.Resize(, 16).Copy Cells(Q(0).Row, Q(1))
        [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] nRng = Dn Else [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
    .Item(Dn.Value) = Q
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]

[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]If[/COLOR] Not nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] nRng.EntireRow.Delete
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick

Thanks Mick! Worked exactly how I needed it. Appreciate your time.
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

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