Grouping records in an Excel sheet which have the same values in one column but only one unique reco-CodePudding

Dummy data of a tournament

Above is the example of the dummy data. My goal is to use VBA to group the data so that there is only one name displayed and the 3 Games populated with the Results so there would only be one line for the name as well as the 3 Games' results in the same line.

Example of the output data

CodePudding user response：

Well, this is not as easy as first appears, however, this works:

So, the country is returned with classic index & match. The results are built by finding the result against each player and round. This expects blanks in the other cells for each player.

CodePudding user response：

Try this:

Sub mSummarise()
'
' Macro1 Macro
'

'
    Dim lData, lSummary, lFilter As String
    Dim lRow1, lRow2, lRow3, lCol1, lCount As Long
    
    lData = ActiveSheet.Name
    Range("A1").Select
    Selection.End(xlToRight).Select
    lCol1 = ActiveCell.Column
    Range("A1").Select
    Selection.End(xlDown).Select
    lRow1 = ActiveCell.Row
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Summary"
    Sheets(lData).Activate
    Range("A1:B" & lRow1).Select
    Selection.Copy
    Sheets("Summary").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$B$" & lRow1).RemoveDuplicates Columns:=Array(1, 2), Header _
        :=xlNo
    Range("A1").Select
    Selection.End(xlDown).Select
    lRow2 = ActiveCell.Row
    Sheets(lData).Select
    Range(Cells(1, 3), Cells(1, lCol1)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets(lData).Select
    For lCount = 3 To lCol1
    Range(Cells(1, 1), Cells(lRow1, lCol1)).Select
    Selection.AutoFilter
    ActiveSheet.Range(Cells(1, 1), Cells(lRow1, lCol1)).AutoFilter Field:=lCount, Criteria1:="<>", Operator:=xlAnd
    Range(Cells(1, 1), Cells(lRow1, lCount)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    lFilter = ActiveSheet.Name
    ActiveSheet.Paste
    Range("A1").Select
    Selection.End(xlDown).Select
    lRow3 = ActiveCell.Row
    Sheets("Summary").Select
    Application.CutCopyMode = False
    Cells(2, lCount).Select
    ActiveCell.Formula = "=VLOOKUP(A2," & lFilter & "!$A$2:" & Cells(lRow3, lCount).Address & "," & lCount & ",0)"
    Range(Cells(2, lCount), Cells(2, lCount)).Copy
    Range(Cells(2, lCount), Cells(lRow3, lCount)).Select
    ActiveSheet.Paste
    Range(Cells(2, lCount), Cells(lRow3, lCount)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(lFilter).Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    Sheets(lData).Select
    Next
    Selection.AutoFilter
    Range("A1").Select
    Sheets("Summary").Select
    Range("A1").Select
End Sub