#1
|
|||
|
|||
Script Directory
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. https://www.mrexcel.com/forum/newthr...ostthread&f=10 Code:
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 Last edited by charlesdh; 06-09-2018 at 01:47 PM. Reason: Posted to another forum |
#2
|
|||
|
|||
try
Code:
For X = LBound(d.keys) To UBound(d.keys) - 1 cpt = d.keys()(X) N = Application.WorksheetFunction.CountIf(rng, d.keys()(X)) With frmRecordUpdate.lstSelection .AddItem cpt .List(.ListCount - 1, 1) = N End With ' ' ' Next X Last edited by NoSparks; 06-10-2018 at 06:25 AM. |
#3
|
|||
|
|||
NoSparks.
Thanks, I'll give it a try and let you know. |
#4
|
|||
|
|||
NoSparks,
Thanks for your suggestion. I discovered that I did not set the "Column Count" to 2. All works well! |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Newbie - Help - VBA script | jajukhan | Word VBA | 1 | 11-04-2017 10:23 AM |
Some problems in this script | eduzs | Word VBA | 4 | 05-17-2017 04:14 PM |
directory: want to a ensure all three lines in a directory entry appear on the same page. | JON25T | Mail Merge | 3 | 12-22-2016 01:34 PM |
Bolding in script | ksigcajun | Word VBA | 10 | 02-23-2015 08:29 AM |
Help with VBA script | nsyrax | Word VBA | 1 | 01-18-2014 03:38 AM |