Macro to generate list of Names from a list where the names

[Cosmos75]

I have a list of names (Names) in sheet 1 Column A that I need to be able to paste onto a new sheet. Most names appear more than once.

The thing is I need to paste each name only once. (Lets call this new list NamesOnce) How can I do this with a macro?

On top of that, each name has a value associated with it, let call that SALES. Is there anyway to have next to the NamesOnce list the Maximum Value associated with a certain name?

E.g

Names Sales
Lisa 4
Bob 4
Josh 1
Paula 7
Lisa 5
Bob 2
Bob 6
Josh 10
Paula 8

I need to have this on a new sheet

Names Max
Lisa 5
Bob 6
Josh 10
Paula 8

Can I do this?

 

[paelinck]

A Pivot Table can do exactly that: make a unique list of names and add the maximum (or sum or minimum or average) of the corresponding values. So don't use a macro for this. See Excel Help for the use of Pivot Tables.

Marc

 

[Dave Hawley]

Hi

Pivot Table would be good.


But here's a macro anyway.

Sub DoIt()
Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True

Range("A1", Range("B65536").End(xlUp)).SpecialCells _
(xlCellTypeVisible).Copy Destination:=Sheets("Sheet1").Range("A1")

ActiveSheet.ShowAllData
End Sub

 

[Cosmos75]

Dave,

That works, but it doesn't choose the maximum value for each person, just the first one. This list is not sorted and if there is a way I would rather not sort if.



Maybe have an array formula with the ranges defined using End(xlUp). After pasting the Names only once.

Like

Range1 = Range("A1",Range("A65536").End(xlUp).Address)
Range2 = Range("B1",Range("B65536").End(xlUp).Address)

Sheets("Target").Select
Range("B1").Select
Selection.FormulaArray = "=MAX(IF(Range1=A2,Range2))"

It's A2 since A2 would have "Name" in it.

Probably have to first count the number of unique names on Target sheet, loop through A2 until the end. Maybe count the number of unique names using select Range of Target Sheet ColumnA, then RowCount.Selection?

Is there an alternative to looping?

 

[Joe Was]

Sub Find_Names()

'Finds all the unique names, count the number of times each name is listed and give the total value of each name.
'Data is on Sheet2: Names(G), Values(I), Results are listed on Sheet3: Names(H), Count(I) & Values(J).
Application.ScreenUpdating = False

'Find unique names on Sheet2(G), col(7) & list on Sheet3(H).
With Intersect(ActiveSheet.Columns(7), ActiveSheet.UsedRange)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet3").Range("H1")
ActiveSheet.ShowAllData
End With

'Sort unique names on sheet3(H).
Sheets("Sheet3").Select
Columns(8).Sort Key1:=Range("H1")

'Count occurrences of names on Sheet2(G), col(7).
'List the number of times each unique name occurred on Sheet2(G), next to the list on sheet3(I).
With Worksheets("Sheet3")
.Range("I1").Formula = "=CountIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1)"
.Range("I1:I" & .Range("H1").End(xlDown).Row).FillDown
End With

'Sum values by name on sheet2(I).
'List the sum of values for each unique name occurred on Sheet2: Name(G), Value(I),
'on sheet3: Name(H) & Value(J).
With Worksheets("Sheet3")
.Range("J1").Formula = "=SumIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1,Sheet2!I$1:I$" & Worksheets("Sheet3").Range("H1").End(xlDown).Row & ")"
.Range("J1:J" & .Range("H1").End(xlDown).Row).FillDown
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The results are: Name, number of sales, Total value of sales. All as unique names list, extracted from the master (non-unique) list of data. Hope this helps. JSW

 

[Cosmos75]

Joe Was,

Thanks for the code, it'll come in handy for another part of my workbook, but what I was hoping to show the maximum value of sales for each person and not the sum of sales for each person.

THANKS FOR THE CODE!!

 

[ChristopherHo]

Sub Find_Names()

'Finds all the unique names, count the number of times each name is listed and give the total value of each name.
'Data is on Sheet2: Names(G), Values(I), Results are listed on Sheet3: Names(H), Count(I) & Values(J).
Application.ScreenUpdating = False

'Find unique names on Sheet2(G), col(7) & list on Sheet3(H).
With Intersect(ActiveSheet.Columns(7), ActiveSheet.UsedRange)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet3").Range("H1")
ActiveSheet.ShowAllData
End With

'Sort unique names on sheet3(H).
Sheets("Sheet3").Select
Columns(8).Sort Key1:=Range("H1")

'Count occurrences of names on Sheet2(G), col(7).
'List the number of times each unique name occurred on Sheet2(G), next to the list on sheet3(I).
With Worksheets("Sheet3")
.Range("I1").Formula = "=CountIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1)"
.Range("I1:I" & .Range("H1").End(xlDown).Row).FillDown
End With

'Sum values by name on sheet2(I).
'List the sum of values for each unique name occurred on Sheet2: Name(G), Value(I),
'on sheet3: Name(H) & Value(J).
With Worksheets("Sheet3")
.Range("J1").Formula = "=SumIf(Sheet2!" & Intersect(Sheet2.Columns(7), Sheet2.UsedRange).Address & ",H1,Sheet2!I$1:I$" & Worksheets("Sheet3").Range("H1").End(xlDown).Row & ")"
.Range("J1:J" & .Range("H1").End(xlDown).Row).FillDown
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The results are: Name, number of sales, Total value of sales. All as unique names list, extracted from the master (non-unique) list of data. Hope this helps. JSW

Hi JoeWas - I realize this post is literally more than a decade old, but I am really trying to make this work and I can't get it to. Using Excel2010 - very new to macros so I'm probably doing something very minor wrong. Is there any way possible you could send through a sample workbook with this? I am positive I would be able to get it to work with an example to work off of. I am really hoping you are still active on these forums!!

Cheers,

Christopher.