CoolEdit List Box

[Yogi39]

Awhile ago I got great help from Mike S here and he submited this great code for and Excel Edit List Box :

Option Explicit
Dim InEvent As Boolean

Private Sub btnCancel_Click()
  Unload Me
End Sub

Private Sub btnOK_Click()
  ' Real app would do something here
  ''Unload Me
  'MsgBox Me.txtEB.Text
  ' Me >

    If Me.txtEB.Text = "" Then Unload Me: Exit Sub
    'On Error Resume Next
    If Me.lstLB.Text <> &quot;&quot; Then
    Sheets(&quot;Generate&quot;).Range(&quot;A3&quot;) = Me.lstLB.Text
    Unload Me
    Sheets(&quot;Generate&quot;).Range(&quot;B3&quot;).Select
    Else
    MsgBox Me.txtEB.Text & &quot;  invalid entry !&quot;
    With Me.txtEB 'TextBox2
    .SetFocus
    .Text = txtEB
    .SelStart = 0
    .SelLength = Len(txtEB)
    End With
    End If

  ' Me <
  
End Sub

Private Sub lstLB_Click()
' Exit if Click event activated while TextBox Change event running
  If InEvent Then Exit Sub
  InEvent = True
  
'Put the selected list item into the edit box
  With Me.lstLB
    Me.txtEB.Text = .List(.ListIndex)
  End With

'Store the current edit box contents, for checking if deleting.
  With Me.txtEB
    oldText = .Text
    .SetFocus
  End With
  
  InEvent = False

End Sub

Private Sub txtEB_Change()
Dim i As Variant
Dim ebText As String, lbText As String
Dim iNums As Integer

Static fSendKeys As Boolean

  If InEvent Then Exit Sub
  InEvent = True

'Get the edit box text
  ebText = Me.txtEB.Text
    
'If empty, cancel the selection and quit
  If ebText = &quot;&quot; Then
    Me.lstLB.ListIndex = -1
  Else
    'Find the first item in the list box that starts with the text from the edit box
    i = Application.Match(ebText & &quot;*&quot;, vaList, 0)
    
    If IsError(i) = False Then
      'If there is an item, select it in the list box
      Me.lstLB.ListIndex = i - 1
        
      'Get the text of the list box item
      lbText = Me.lstLB.List(i - 1)
        
      'If not deleting, auto-complete the edit box.
      If Len(ebText) > Len(oldText) Or Left(ebText, Len(oldText)) <> ebText Then
     
        'Find how many extra characters there are in the list box string
        iNums = Len(lbText) - Len(ebText)
        
       'If we have some characters left, auto-complete the edit box and set a flag to say so.
        If iNums > 0 Then
            
          'Complete the edit box text with the list box text, but select the extra characters.
          'This makes sure the automatically added text gets deleted as you continue typing.

          With Me.txtEB
            .Text = ebText & Right(lbText, iNums)
            .SelStart = Len(ebText)   '+ 1
            .SelLength = iNums
          End With
        End If
      End If
    Else
      'If not match, clear the selection
      Me.lstLB.ListIndex = -1
    End If
  End If
 
 'Store the current edit box contents, for checking if deleting.
  oldText = ebText
    
  InEvent = False
 
End Sub

Private Sub txtEB_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Code source:  VB2TheMax website
  With Me.lstLB
    If Shift Then
      ' do nothing if a shift key is pressed
    ElseIf KeyCode = vbKeyUp Then
      ' move on previous item
      If .ListIndex > 0 Then
        .ListIndex = .ListIndex - 1
      End If
      KeyCode = 0
    ElseIf KeyCode = vbKeyDown Then
      ' move on next item
      If .ListIndex < .ListCount - 1 Then
        .ListIndex = .ListIndex + 1
      End If
      KeyCode = 0
    End If
    
    'MsgBox Me.txtEB.Text
  End With

' Me >
    If KeyCode = vbKeyReturn Then
    KeyCode = 0
    btnOK_Click
    End If
  ' Me <
End Sub

Private Sub UserForm_Initialize()
Dim wks As Worksheet
Dim i As Long
Dim c, CC As Variant

For Each c In Sheets(&quot;List&quot;).Range(&quot;A:A&quot;)
If c = &quot;&quot; Then Exit For
CC = CC + 1
Next


'Initialise the edit box and list box
  With Me.txtEB
    .SetFocus
    .Text = &quot;&quot;
  End With

  Set wks = ThisWorkbook.Worksheets(&quot;List&quot;)
  With wks
    vaList = Range(.Cells(2, 1), .Cells(CC, 1)).Value
  End With
  
  With Me.lstLB
    For i = 2 To CC
      .AddItem wks.Cells(i, 1).Value
    Next i
    .ListIndex = -1
  End With
  oldText = &quot;&quot;
  
  InEvent = False
  
End Sub

This works Great !

Trying to combine with this code which populates a list box with UNIQUE values from a range :

Option Explicit
'   This example is based on a tip by J.G. Hussey,
'   published in "Visual Basic Programmer's Journal"

Sub RemoveDuplicates()
    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
    
'   The items are in A1:A105
    Set AllCells = Range("A:A")
    
'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
    Next Cell

'   Resume normal error handling
    On Error GoTo 0

'   Update the labels on UserForm1
    With UserForm1
        .Label1.Caption = "Total Items: " & AllCells.Count
        .Label2.Caption = "Unique Items: " & NoDupes.Count
    End With
    
'   Sort the collection (optional)
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
    
'   Add the sorted, non-duplicated items to a ListBox
    For Each Item In NoDupes
    If Item <> &quot;&quot; Then
        UserForm1.ListBox1.AddItem Item
        End If
        
    Next Item

'   Show the UserForm
    UserForm1.Show
End Sub

However I CANT Seem to combine the codes to worl together...Can anyone help me ?

 

[Zathras]

I can't quite tell what the first routine is supposed to be doing, but to "combine the codes to worl (sic) together" you can do something like this:

1. Put another button on the form with the caption "Remove Dups"

2. Call the second routine on the click event:

   Private Sub CommandButton1_Click()
     RemoveDuplicates
   End Sub

3. The second routine should go into a separate code module (although strictly speaking it doesn't absolutely have to) and you need to fix it in a couple of places:

3A: Change

 Set AllCells = Range("A:A")

to

     Set AllCells = Range("A1:A105")

3B: Add a line to clear the listbox:

          UserForm1.lstLB.Clear

3C: Change the list box name to match what you renamed the list box to:

          UserForm1.lstLB.AddItem Item

3D: Remove the line:

          UserForm1.Show

I think that's all, but I may have missed one or two changes that I had to make to get it to work. At least, this should get you closer.

 

[Yogi39]

I can send you the workbook if you like

 

[Zathras]

No, thanks. That's not the way it is done here. If you have any further questions or suggestions, you should just provide all of the necessary details in your post so all can enjoy! [SMILE]

 

[Yogi39]

Sorry, Was not thinking too well...I modified to work using List Sheet ....however was trying to avoid that extra step !

I combined both codes to work....
I use the removedups to write to another sheet, then read the list from that sheet.
I was trying to combine the codes so that I can avoid this extra step.
However I will keep working on it as it's a pretty cool to get an Edit List box in Excel !

Was trying to combine this part of the code for the Edit List

Set wks = ThisWorkbook.Worksheets("List")
  With wks
    vaList = Range(.Cells(2, 1), .Cells(CC, 1)).Value
  End With
  
  With Me.lstLB
    For i = 2 To CC
      .AddItem wks.Cells(i, 1).Value
    Next i
    .ListIndex = -1
  End With

with this portion from the Dup module

Add the sorted, non-duplicated items to a ListBox
    For Each Item In NoDupes
    If Item <> &quot;&quot; Then
        UserForm1.ListBox1.AddItem Item
        End If
        
    Next Item