Sub MacBurk()
'
' Macro written 19-OCT-2006 by David Marks
'

'Define Variables
Dim myDir As String
Dim myFile As String
Dim SrcSheet As String
Dim DstSheet As String

Dim myName As String
Dim myCountry As String

Dim MaxLoop1 As Integer
Dim Loop1 As Integer
Dim MaxLoop2 As Integer
Dim Loop2 As Integer
Dim MaxLoop3 As Integer
Dim Loop3 As Integer

'Set file details
myDir = ""
myFile = "GTG_Burk.xls"
SrcSheet = "Sheet1"
DstSheet = "Sheet2"
DestRow = 0

'Activate file
Windows(myFile).Activate

'Clear destination worksheet
Sheets(DstSheet).Select
Cells.Select
Selection.Delete

'Start
Worksheets(SrcSheet).Activate

MaxLoop1 = Sheets(SrcSheet).UsedRange.Rows.Count
For Loop1 = 2 To MaxLoop1
    Sheets(SrcSheet).Select                                         'move to source sheet
    myCountry = Cells(Loop1, 2).Range("a1").Value


    'check if destination already contains current country
    Sheets(DstSheet).Select                                         'move to destination sheet
    count2 = 0                                                      'set counter
    MaxLoop2 = Sheets(DstSheet).UsedRange.Rows.Count                'set number of row to check
    For Loop2 = 1 To MaxLoop2                                       'start loop
        If Cells(Loop2, 1).Range("a1").Value = myCountry Then       'if country already exists
            count2 = count2 + 1                                     'increment counter
        End If
    Next Loop2
    
    'write data to destination sheet
    If count2 = 0 Then                                              'if current country does not exist
        Sheets(DstSheet).Select                                     'move to destination sheet
        DestRow = DestRow + 2                                       'move to next row
        Cells(DestRow, 1).Range("a1").Value = myCountry             'write new country
        
        For Loop3 = Loop1 To MaxLoop1                               'check from current pointer to end
            Sheets(SrcSheet).Select                                 'move to source sheet
            If Cells(Loop3, 2).Range("a1").Value = myCountry Then   'look for match to current country
                myName = Cells(Loop3, 1).Range("a1").Value          'get next name
            
                Sheets(DstSheet).Select                             'move to destination sheet
                DestRow = DestRow + 1                               'move to next row
                Cells(DestRow, 1).Range("a1").Value = myName        'write next name
            End If
        Next Loop3
    End If
    
Next Loop1

Range("a1").Select

dummy = MsgBox("Finished", vbOKOnly)

End Sub