ListBox Duplicating selection

[gheyman]

I have a ListBox that puts the selected items, from the List, onto a worksheet/tab

When the user selects an item from the list (Multiple selection allowed) it puts the value on the tab but it also repeats the previous selections

Lets say the ListBox has a list of 1 through 10 in it

If the user selects #1, 1 appears in A1 on "SelectedCats"
If the user then selects #5, in A2 #1 is loaded and #5 is loaded in A3
If the user then select #8, #1 loads in A4, #5 loads in A5 and #8 loads in A6 and so on

I dont want it to keep loading the previous selections , I juts want to see #1, #5 and #8

Here is the Code
Private Sub ListBox1_Change()
Sheets("SelectedCats").Visible = True
UnProtectit
Dim Sh As Worksheet
Dim Rng As Range
Dim NextCell As Range
Dim i As Long
Dim r As Long
Dim BoundCol As Long

Set Sh = Worksheets("SelectedCats")

With Sh
If Not IsEmpty(.Cells(1, 1)) Then
Set Rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set NextCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End With

With ListBox1
BoundCol = .BoundColumn
' Add new selections
For i = 1 To .ListCount - 1
If .Selected(i) Then
If Not Rng Is Nothing Then
On Error Resume Next
r = WorksheetFunction.Match(.List(i, BoundCol), Rng, False)
If Err <> 0 Then
Err.Clear
NextCell = .List(i, BoundCol)
End If
On Error GoTo 0
Else
Sh.Cells(1, 1) = .List(i, BoundCol)
End If
With Sh
Set Rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set NextCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

End If
Next i

End With
Protectit
Sheets("SelectedCats").Visible = True
End Sub