ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   copy unique values into listbox, then modify sheet from these values (https://www.excelbanter.com/excel-programming/434113-copy-unique-values-into-listbox-then-modify-sheet-these-values.html)

Matthew Dyer

copy unique values into listbox, then modify sheet from these values
 
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[_2_]

copy unique values into listbox, then modify sheet from these valu
 
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.


Matthew Dyer

copy unique values into listbox, then modify sheet from thesevalu
 
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

copy unique values into listbox, then modify sheet from thesevalu
 
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?

Patrick Molloy[_2_]

copy unique values into listbox, then modify sheet from these
 
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?



All times are GMT +1. The time now is 06:49 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com