Macro for many to one copy and paste

CAM174

New Member
Joined
Nov 27, 2015
Messages
8
Hi all,

I'm not sure if I'm even explaining this right.

I have two sheets in a workbook. Sheet1 has about 57000 rows and 32 columns of data. I will not show exactly what my sheets look like because this is for work.

Examples are purposely vague, but here goes:

Col E: Names of people. E.g. Bob.
Col. D: Names of their friends who they partner with for games. Bob has about 10 friends, sometimes he likes to play with Jane or Bill, and the games vary.
Col M: Games listed.

Based on the specific game, and the key player and their partner, I need to populate Sheet2, so if Bob(Col E) is listed with 5 games(Col M), and 8 partners(Col D), will be listed 8 times, or 5 times, whichever is more.

Can this be done with Macros?

Please help me, thank you. If you need it explained differently, just ask.

Thank you!
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
To clarify:

One column needed number of instances of specific cell counts from sheet1.

It turns out I can use COUNTIFS with two ranges for that.

but how do I get about 60,000 rows of data from sheet1 into sheet2?

If Bob is listed 70+ times in Sheet1, I want his name listed once in sheet2, with the exact count of his instances in col2 of sheet2.

Is that clear? Please help!
 
Upvote 0
See if this works... this is assuming the player name is in column A of the first tab and the first tab is named "Sheet1".

Code:
Sub CountPlayer()
'
' CountPlayer Macro
'


'

'Declare and Set variables


    Dim MyCell As Range, MyRange As Range, SortRange As Range
     
    Set MyRange = Sheets("Sheet1").Range("A1")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    Set SortRange = Range("A2").CurrentRegion
    
 'This step sorts the data on the 1st tab by player name
    Range("A1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:= _
        MyRange, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
        
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange SortRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
  'Next is to copy paste the player name only onto a new sheet
    MyRange.Select
    MyRange.Copy
    
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "List1"
    
    Worksheets("List1").Range("A1").PasteSpecial Paste:=xlPasteValues
    Worksheets("List1").Range("B1").Value = "# of instances"
    Columns("A:B").EntireColumn.AutoFit
    
   'Next step is to loop through the columns with the countif formula_
    'to count the # of instances for each player name
    
    Dim InvCt As Long
    
    NumrowsCt = Range("A2", Range("A2").End(xlDown)).Rows.Count
    
    For xp = 2 To NumrowsCt + 1
    
    InvCt = Application.WorksheetFunction.CountIf(Range("A2:A" & NumrowsCt + 1), Cells(xp, "A").Value)
    Cells(xp, "B") = InvCt
    
    Next xp
    
    'Advanced Filter by unique vendor name values
    Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    
    'Copy-paste the visible cells to a new spreadsheet
    Range("A1").CurrentRegion.Select
    Range("A1").CurrentRegion.Copy
    
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "List2"
    
    Worksheets("List2").Range("A1").PasteSpecial Paste:=xlPasteValues
    Columns("A:B").EntireColumn.AutoFit
End Sub
 
Upvote 0
Hi!

Thank you SO MUCH!

But after changing the values, and running it, the line, "MyRange.Select" right after the 3rd commented line had an error:

"Run-time error of '1004'
Select method of Range class failed.

Um, so in my sheet1, the player name is column E, and the game(unique-ish identifier) is in column M.
Would that make a difference in the macro?

Thanks for all your help!
 
Upvote 0
So i changed the player column from A to column E. See if this works... and not sure the actual purpose of the "unique identifier" column M???

Code:
 Sub PlayerCount()

'Declare and Set variables


    Dim MyCell As Range, MyRange As Range, SortRange As Range
     
    Set MyRange = Sheets("Sheet1").Range("E1")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    Set SortRange = Range("E2").CurrentRegion
    
 'This step sorts the data on the 1st tab by player name
    Range("E1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:= _
        MyRange, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
        
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange SortRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
  'Next is to copy paste the player name only onto a new sheet
    MyRange.Select
    MyRange.Copy
    
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "List1"
    
    Worksheets("List1").Range("A1").PasteSpecial Paste:=xlPasteValues
    Worksheets("List1").Range("B1").Value = "# of instances"
    Columns("A:B").EntireColumn.AutoFit
    
   'Next step is to loop through the columns with the countif formula_
    'to count the # of instances for each player name
    
    Dim InvCt As Long
    
    NumrowsCt = Range("A2", Range("A2").End(xlDown)).Rows.Count
    
    For xp = 2 To NumrowsCt + 1
    
    InvCt = Application.WorksheetFunction.CountIf(Range("A2:A" & NumrowsCt + 1), Cells(xp, "A").Value)
    Cells(xp, "B") = InvCt
    
    Next xp
    
    'Advanced Filter by unique vendor name values
    Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    
    'Copy-paste the visible cells to a new spreadsheet
    Range("A1").CurrentRegion.Select
    Range("A1").CurrentRegion.Copy
    
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "List2"
    
    Worksheets("List2").Range("A1").PasteSpecial Paste:=xlPasteValues
    Columns("A:B").EntireColumn.AutoFit
End Sub
 
Upvote 0
Col E = Bob, main player.

in the sheet, Bob is listed as playing five different games, a total of 105 times, with 16 different partners.

Every instance of a game played is col M.

That matches up with each partner, in Col. D.

But Bob played 105 times total. Not that relevant, until you realize that the majority of main players only play like 10 games, max, but closer to like 2 on average.

I need to keep track of the Bob's on a different sheet, but no one can fall through the cracks. They have to all be accounted for, even if they only played once.
 
Upvote 0
It's okay if we don't figure it out, might be useful for someone googling something this specific, though.

But I'm going to make a pivot table out of E for row label, and M for Values, and copy and paste it like that for all columns.

Thanks for your help! Much appreciated!
 
Upvote 0
I'm still a little unsure of what you need the exact output to be??? The total number of times a player played? Or just the total number of times a player is listed in column E? Or something totally different?
 
Upvote 0
Sorry:

For every unique main player (that is in column E), how many rows in column M correspond with that.

So, you 3rd question is what I meant.
 
Upvote 0
For example:

Person A has 173 rows, because they played 173 games.
Person B has 515 rows.
Person C has 1.
Person D has 2.
Person E has 5.

Except the rows are out of order, and the columns in sheet1 and sheet2, half are the same but out of order. And we only need 1 instance of col E in sheet2, with count of instances in col J in sheet2.

Is that clearer? Sorry about the confusion.
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,853
Members
452,361
Latest member
d3ad3y3

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