Script Directory

[CharlesH]

I'm trying to use a Script Directory, but having issue with it. The following code works up to the point I have remarked.
I have a "List" box the shows records they may show multiple times. I manually select one or more of the same record that I want to move. If I select "666" and "666" I then select "999". The lstSelection in the code should be populated with
"666 and 2" the 2 indicates the number of selection for the for the same code. The selection for "999" should see a count of 1. "999 1".
Any help would be appreciated.
I also posted here.
http://www.msofficeforums.com/excel-programming/39330-script-directory.html

Private Sub cmd_Move_Click() '''New code

    Dim i As Long
    Dim f As Long
    Dim rng As Range
    Dim X As Long
    Dim cpt As Variant, N As Long
    Dim d As Object, C As Variant
    Dim lrow As Long
    ThisWorkbook.Worksheets("SelectRecords").Activate
    
Set d = CreateObject("Scripting.Dictionary")
lrow = Sheets("SelectRecords").Range("A65536").End(xlUp).Row + 1

For f = 0 To frmRecordUpdate.lstBox2.ListCount - 1
    
   
    If frmRecordUpdate.lstBox2.Selected(f) = True Then
         
        Sheets("SelectRecords").Range("A" & lrow).Value = lstBox2.List(f, 1)
        lrow = Sheets("SelectRecords").Range("A65536").End(xlUp).Row + 1
    End If
Next f
Set rng = ActiveSheet.Range("A2:A" & lrow)
C = rng
For i = 1 To UBound(C, 1)
  d(C(i, 1)) = 1
Next i
'''''''''''' all of the code above works '''''''''''''''
For X = LBound(d.keys) To UBound(d.keys)
    cpt = d.keys()(X)
    N = Application.WorksheetFunction.CountIf(rng, d.keys()(X))
    frmRecordUpdate.lstSelection.AddItem cpt
    '''' Fails here I select 2 list items. "N" shows 2 ''
    '' when frmRecordUpdate.lstSelection updates ''
    '' the "List valus is replaced by "N" ''
    ' lstselection should show " 66623    2"
    frmRecordUpdate.lstSelection.List(X, 1) = N '''' fails here
    'frmRecordUpdate.CmboPickCpt.AddItem d.keys()(X)
      '  frmRecordUpdate.lstBox2.ColumnCount = 20
      '  frmRecordUpdate.lstBox2.RowSource = ("A3:U" & lrow)
      
Next X
End Sub