Help with function to organise some data

Alright it's pretty hard to concisely describe what I want to do in just the title, I'll outline what I've got and what I want to do.

I'm mapping study site locations of clinical trials. I have lists of data of the Author of the article on the study, the year, the study location, and lattitude and longitude coordinates.
I can make a map where it plots the study locations and shows the Author and year when you mouseover on a site.
You can have a look here:
http://www.gpsvisualizer.com/display...80.170.85.html

The problem is when there are multiple studies at a single location, with this method you cannot see all the different authors of the different studies there. So for the sites where there are multiple studies, I want to list the authors and years.

Currently my source data is in the format of something like:

Author-Year --------Site---------Count
Sutanto-2009---------------Site A-------3
Maguire-2006---------------Site B-------2
Maguire-2006---------------Site A-------3
Baird-1995------------------Site B-------2
Baird-1995------------------Site C-------2
Murphy-1993----------------Site D-------2
Fryauff-1997----------------Site E -------1
Fryauff-1997----------------Site C-------2
Lacy-2002------------------Site A-------3
Sumawinata-2003----------Site D-------2

I'm wondering if it's possible to have a function which looks in Count to see if there is more than one occurance of a study at that site, and if so list all the authors-years at that site, so it ends up looking something like:

Author-Year--------------------------------Site---------------Count
Sutanto-2009, Maguire-2006, Lacy-2002-----------Site A------------------3
Maguire-2006, Baird-1995--------------------------Site B-------------------2
Baird-1995, Fryauff-1997---------------------------Site C------------------2
Murphy-1993, Sumawinata-2003------------------Site D------------------2
Fryauff-1997----------------------------------------Site E-----------------1

Would anyone be able to help with a way to accomplish this? That'd be great!

Cheers

Hi Snowtoad,

Just wanted to know what would be results if there would be two more entry like:-
Author-Year --------Site---------Count
Lacy-2002----------Site A----------2
Lacy-2002----------Site B----------3

Thanks.

Regards,
DILIPandey

< click on below 'star' if this helps >

Hi Snowtoad,

Apologies, I have missed this one.
Here you go, assuming you have your data arranged in column A to C, use following quick code (though it needs little improvisation but still it will work):-

Sub Macro4()
Application.ScreenUpdating = False

    Cells(1, 1).Select
    Selection.CurrentRegion.Select
    
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R11C3").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable5", DefaultVersion:=xlPivotTableVersion10

    ActiveSheet.PivotTables("PivotTable5").AddFields RowFields:=Array("Site", _
        "Author-Year")
    ActiveSheet.PivotTables("PivotTable5").PivotFields("Site").Orientation = _
        xlDataField

    ActiveSheet.PivotTables("PivotTable5").PivotSelect "", xlDataAndLabel, True
    Selection.Cut
    Range("A1").End(xlToRight).Select
 
    ActiveCell.Offset(0, -3).Range("A1").Select
    ActiveSheet.Paste

    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    
While ActiveCell.Value <> ""
Selection.Offset(1, 1).Select
    If Selection.Offset(1, 0).Value = "" Then
    Selection.Copy
    Else
    Range(Selection, Selection.End(xlDown)).Copy
    End If
    Selection.Offset(0, -1).Select
    If Selection.Offset(1, 0).Value = "" Then
    Selection.End(xlDown).Select
    Else
    Selection.Offset(1, 0).Select
    End If
    
    Selection.End(xlToLeft).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    ActiveCell.Select
    If Selection.Offset(0, 1).Value = "" Then
    
    Selection.End(xlToRight).Select
    Else
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    End If
Wend

Range("a1").End(xlToRight).Select

ActiveCell.Offset(0, -1).Formula = "=IF(ISNUMBER(SEARCH(""total"",RC[1])),""n"",""y"")"
Selection.Offset(0, -1).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown

While ActiveCell.Value <> ""
    If ActiveCell.Value = "y" Then
    ActiveCell.EntireRow.Delete
    Else
    ActiveCell.Offset(1, 0).Select
    End If
Wend
Selection.EntireColumn.Delete
Selection.Offset(-1, 1).Select
Selection.EntireColumn.Delete
Selection.CurrentRegion.Copy
Range("a1").End(xlToRight).Offset(0, 1).Select
Selection.PasteSpecial
Selection.End(xlDown).Select
Selection.EntireRow.Delete
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub

Let me know if you need further assistance. Thanks.

Regards,
DILIPandey

<click on below 'star' if this helps >

Hello Snowtoad,

Firstly list your all unique locations in Sheet2. Select the Site column, Go to Advanced Filter >> Copy to other location, click Unique Records Only.

Now insert this VBA code (I am not an owner of this code, got it through search)

Function CONCATIF(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
            Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
    ' code base by Mike Rickson, MrExcel MVP
    ' used as exactly like SUMIF() with two additional parameters
    ' of delimiter and "no duplicates" as TRUE/FALSE if concatenated values
    ' might include duplicates  ex. =ConcatIf($A$1:$A$10,C1,$B$1:$B$10,", ",True)

Dim i As Long, j As Long

With compareRange.Parent
    Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
End With

If compareRange Is Nothing Then Exit Function
If stringsRange Is Nothing Then Set stringsRange = compareRange
Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
                                    stringsRange.Column - compareRange.Column)
    
    For i = 1 To compareRange.Rows.Count
        For j = 1 To compareRange.Columns.Count
            If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
                If InStr(CONCATIF, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                    CONCATIF = CONCATIF & Delimiter & CStr(stringsRange.Cells(i, j))
                End If
            End If
        Next j
    Next i
    CONCATIF = Mid(CONCATIF, Len(Delimiter) + 1)
End Function

then use Sheet2!B2, copy down,

=CONCATIF(Sheet1!$B$2:$B$1439,$A2,Sheet1!$A$2:$A$1439,", ",TRUE)

C2, copy down.

=INDEX(Sheet1!C:C,MATCH(A2,Sheet1!B:B,0))

See the attached.

Awesome, thanks, that seems to work! Thank you both so much for your efforts! This will be really useful

EDIT:
Just one more thing...
Say if there were two studies at one site, but both by the same Author and year.
Instead of just displaying the single Author-year e.g.


2 Studies Koram-2008

Would it be possible for it to realize when the author/year is duplicated and make it like:


2 Studies (2)Koram-2008

and


3 Studies Batty-1998, de Vries-2000


to


3 Studies (2)Batty-1998, de Vries-2000

Cheers!