Macro grouping column data into same row

[SeanMorrowJ]

Hi! I have 2 Worksheets and I’d need a Macro that copies data from “Worksheet 1” to “Worksheet 2”.

I’ve been trying to get it to work via long formulas, but it seems unclean, glitchy and overly complex. So I thought a Macro would be a better option but I’m afraid I’m not too familiar in VBA and so I’d appreciate any help on the matter.

Basically, Column B of Worksheet 1 contains a list of names ordered alphabetically. Many of the names appear more than once, so say B2 = B3 = B4 ≠ B5 ≠ B6 = B7…

Each name contains important data in Columns F, G, H, I, J.

What I’d need the macro to do is to copy the name and important data into Worksheet 2, but grouping into one same row all the data belonging to a certain name.

So for example, the name “John Williams” might appear 3 times in Worksheet 1 (B2, B3, B4) and thus has important data in Cells: F2, F3, F4 & G2, G3, G4 & H2, H3, H4 & I2, I3, I4 & J2, J3, J4.

I need Worksheet 2 to create a row for each name, containing all the important data belonging to that particular name. In Worksheet 2, from the start of one set of data to the next, it’s 7 columns across (J2 -> Q2 -> X2). A certain name will never have more than 32 sets of data.

Here’s an example of how Worksheet 1 looks and how Worksheet 2 should end up after the Macro. (the colors are in there just for guidance, they're not necessary)

Thank you VERY MUCH!

 

[mumps]

Try:

Sub Copydata()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim rng As Range
    Dim name As Range
    Dim x As Long
    x = 10
    Dim rngUniques As Range
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("A1:A" & LastRow), Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    For Each rng In rngUniques
        Range("A1:A" & LastRow).AutoFilter Field:=1, Criteria1:=rng
        Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = rng
        For Each name In Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
            Range("F" & name.Row & ":J" & name.Row).Copy Sheets("Sheet2").Cells(Rows.Count, x).End(xlUp).Offset(1, 0)
            x = x + 5
        Next name
        x = 10
    Next rng
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    Application.ScreenUpdating = True
End Sub

 

[SeanMorrowJ]

Thanks for the help mumps, but I get [h=3]Subscript out of range (Error 9)[/h]I changed the name of the sheets in the macro to match the actual names in my Workbook but still nothing.

 

[mumps]

I tried the macro on some sample data and it worked properly. When you click 'Debug' which line of code is highlighted?

 

[SeanMorrowJ]

Ok, I solved it hah sorry my fault. But now I get error 1004: This can't be applied to the selected range. Select only one cell in the range and try again (and it highlights this line):

Sheets("Worksheet 1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("A1:A" & LastRow), Unique:=True

 

[SeanMorrowJ]

Ok, so I tried it in my real Workbook and it seems to be working fine but it's grouping using the data in Column A instead of Column B.

Sheet 2 (target) will always have the same arrangement, but Sheet 1 (source) may occasionally have columns arranged slightly differently, say instead of the data being in Columns F to J, it might be in C (Data 1), and then G to J (Data 2, 3, 4, 5).

How do I make sense of the code? I'd have to modify the x = ... and x + 5... part??

 

[mumps]

It's difficult to design a macro if data keeps shifting around. There may be a solution to this problem but it would be easier to help if I could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of how the location of your data might change using a few examples. If the workbook contains confidential information, you could replace it with generic data.

 

[SeanMorrowJ]

Ok mumps, try the link below. It would be AMAZING if you could set it up the way it is in the attached workbook, cause that's how I really receive the data in bulk. Could you add the condition to only copy the data, if the cell in Column EK (Sheet 1, Data 5) includes the word "YES".

It might be too much of a hassle? MASSIVE THANKS IN ADVANCE MUMPS!!

https://www.mediafire.com/file/3oo5jtq722zvbdp/Worksheet_data_example_Macro.xlsx

 

[mumps]

When you say

set it up the way it is in the attached workbook, cause that's how I really receive the data in bulk

does this mean that the name will always be in column K and Data5 will always be in column EK? Will Data1 to Data4 also always be in the same columns? I noticed that in Sheet2 there are empty columns between Data5 and Data3 and then between Data3 and Data4 and that they are not in numerical order 1 to 4. Will this always be the case? I'm sorry for all these questions but they are necessary to give me an understanding of how the data is organized.

 

[SeanMorrowJ]

Yes, that's how the layout is always going to be set up.

Sorry, the original scenario in my first post meant me doing some manual rearranging, but if the macro can straight up pick the data from Sheet 1 and copy it into Sheet 2, the way it is in the Workbook I've uploaded that'd be so awesome!!

I'll need those empty columns later on, to include a few calculations, formula, etc.

As you see, if Data 5 (Column EK of Sheet 1) does not include the word YES, it is not needed in Sheet 2.