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.

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" wrote:

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.

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...

On Sep 25, 3:15*am, Patrick Molloy
wrote:
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



"MatthewDyer" wrote:
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.- Hide quoted text -

- 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?

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).Ent ireRow.Delete

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

"Matthew Dyer" wrote:

On Sep 25, 3:15 am, Patrick Molloy
wrote:
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



"MatthewDyer" wrote:
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.- Hide quoted text -

- 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?