CorelDRAW Graphics Suite 12 :: Running Script Multiple Times Produces Multiple Copies?

I have this script that basically makes a shape expand by adding an outline, conveting the outline to an object, and then welding the whole thing together.

I have the script set to execute with hotkey ctrl+numpad+

The odd thing is, when I run it once, it seems to work fine and only one object is left, but when I hold down ctrl and press numoad+ over and over again, it seems to produce a new copy of the object everytime.

I'm not sure why this is happening, but I need to get it to stop. 

Sub Expand()    EventsEnabled = False        'Dim vars    Dim c1 As New Color    Dim OrigSelection As ShapeRange    Dim OrigColor As Shape    Dim width1 As Double    Dim height1 As Double    Dim minSize As Double    Dim Thickness As Double        'copy color of current selection    Set OrigColor = ActiveShape    If OrigColor Is Nothing Then Exit Sub    If OrigColor.Fill.Type <> cdrUniformFill Then Exit Sub    c1.CopyAssign OrigColor.Fill.UniformColor        'get thickness to increase by    Set OrigSelection = ActiveSelectionRange    OrigSelection.GetSize width1, height1    If width1 <= height1 Then minSize = width1    If width1 > height1 Then minSize = height1    Thickness = minSize * 0.035        OrigSelection.SetOutlineProperties Color:=CreateRGBColor(0, 0, 0)    OrigSelection.SetOutlineProperties Thickness, ScaleWithShape:=True        'weld    Dim s1 As Shape    Set s1 = OrigSelection(1).Outline.ConvertToObject    Dim s2 As Shape    Set s2 = s1.Weld(OrigSelection(1), True, True)            'auto reduce    's2.Curve.Nodes.All.AutoReduce 0.001    's2.Fill.ApplyUniformFill c1        'delete remnants    OrigSelection.Delete    s1.Delete    'OrigColor.Delete            EventsEnabled = TrueEnd Sub