copy unique values into listbox, then modify sheet from these values

[Matthew Dyer]

Hello Group!

I was hoping someone may be able to help me. My userform has simple
default names (listbox1, listbox2 and commandbutton1). When it is
initialized, I would like all the unique values for column A to be in
listbox1. When selected, the unique value moves over to listbox2. When
the command button is pressed, any row with the unique value for
column A in listbox 2 is saved and the remaining rows are deleted.

 

[Patrick Molloy]

please set a reference (TOOLS/REFERENCE) to Microsoft Scripting Runtime
We'll use this collection to gather unique items.
I beleive the code is quite self explanatory. doublle clicking either
listbox moves the selected item to the other box

Option Explicit
Private Sub CommandButton1_Click()
Dim index As Long
Dim con As Scripting.Dictionary
Dim cell As Range
Set con = New Scripting.Dictionary
If ListBox2.ListCount > 0 Then
'collect data
For index = 0 To ListBox2.ListCount - 1
con.Add ListBox2.List(index), ListBox2.List(index)
Next
'delete rows
For index = Range("A1").End(xlDown).Row To 1 Step -1
If Not con.Exists(Cells(index, 1).Value) Then
Rows(index).Delete
End If
Next
End If
Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox2.AddItem ListBox1.Value
ListBox1.RemoveItem (ListBox1.ListIndex)
End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox1.AddItem ListBox2.Value
ListBox2.RemoveItem (ListBox2.ListIndex)
End Sub

Private Sub UserForm_Initialize()
LoadListbox1
End Sub
Private Sub LoadListbox1()
Dim con As Scripting.Dictionary
Dim cell As Range
Dim text As String
Set cell = Range("A1")
Set con = New Scripting.Dictionary
Do Until cell.Value = ""
text = cell.Value
If Not con.Exists(text) Then
con.Add text, text
ListBox1.AddItem text
End If
Set cell = cell.Offset(1)
Loop
End Sub

 

[Matthew Dyer]

Works great! How do I not include the Header row in the Delete Rows
process? I figured out how to keep it from poping up in the combo box,
but since it doesnt go over to listbox2 it is automatically delted...

 

[Matthew Dyer]

please set a reference (TOOLS/REFERENCE) to Microsoft Scripting Runtime
We'll use this collection to gather unique items.
I beleive the code is quite self explanatory. doublle clicking either
listbox moves the selected item to the other box

Option Explicit
Private Sub CommandButton1_Click()
  Dim index As Long
  Dim con As Scripting.Dictionary
  Dim cell As Range
  Set con = New Scripting.Dictionary
  If ListBox2.ListCount > 0 Then
    'collect data
    For index = 0 To ListBox2.ListCount - 1
     con.Add ListBox2.List(index), ListBox2.List(index)
    Next
    'delete rows
    For index = Range("A1").End(xlDown).Row To 1 Step -1    
     If Not con.Exists(Cells(index, 1).Value) Then
        Rows(index).Delete
     End If
    Next
 End If
 Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ListBox2.AddItem ListBox1.Value
    ListBox1.RemoveItem (ListBox1.ListIndex)
End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ListBox1.AddItem ListBox2.Value
    ListBox2.RemoveItem (ListBox2.ListIndex)
End Sub

Private Sub UserForm_Initialize()
    LoadListbox1
End Sub
Private Sub LoadListbox1()
 Dim con As Scripting.Dictionary
 Dim cell As Range
 Dim text As String
 Set cell = Range("A1")
 Set con = New Scripting.Dictionary
 Do Until cell.Value = ""
    text = cell.Value
    If Not con.Exists(text) Then
     con.Add text, text
     ListBox1.AddItem text
    End If
    Set cell = cell.Offset(1)
 Loop
End Sub






- Show quoted text -

Works awesome! modified it so the header row isnt included in the
listboxes or in the delete row process but other than that, runs
great.

How would I modify the code to also delete any rows that have no value
for column A?

 

[Patrick Molloy]

I wouldn't do it in a loop - its pretty simplistice just to strip out blank
rows with a one-liner:

Range("Source").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

teh named range here is just part of a column , liek G5:G505