Duplicate prevention from Listbox selections to worksheet
 

Hi everybody,
I have a UserForm with a Multi-column listbox set to multiselect. Th
selected members from the listbox are then pasted to a range (Rng1)
The listbox has 8 command buttons which determine the RowSource.
The code works fine, but has a serious flaw. It is possible to selec
and paste an item that already exists on the spreadsheet. I need a wa
to intercept duplicates and not allow them to be entered into th
spreadsheet, and then allowing the remaining non-duplicates to go ahea
and be entered.
Using the variables in my code I need to check each ListBox1.List(i, 0
against the entries already in Rng2. Could really use some help.

Here is My Code:

Private Sub cmdEnterSelection_Click()
Dim ACol As Long
Dim Rng1 As Range
Dim Rng2 As Range
Dim i As Long
Dim j As Long
Dim Entries As Long
Dim CopyCol As Long

Application.ScreenUpdating = False
ACol = Sheets("Takeoff").Range("AlphaCol").Column
'column to copy all formulas from
Set Rng1 = Sheets("Takeoff").Range("TakeOffHeaders") '8Rowsx240Columns
Set Rng2 = Sheets("Takeoff").Range("ScopeNames") '1Rowx240column
TopRow of Rng1
Entries = Excel.WorksheetFunction.CountA(Rng2)
CopyCol = 1 + Entries
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
'Here is the logic I'm trying to code
'If Me.ListBox1.List(i,0)= Anything Already Rng2 Then Next (i)
Columns(ACol).Copy
Columns(ACol + CopyCol - 1).Select
ActiveSheet.Paste
With Rng1
.Cells(1, CopyCol).Value = ListBox1.List(i, 0)
.Cells(2, CopyCol).Value = ListBox1.List(i, 1)
.Cells(4, CopyCol).Value = ListBox1.List(i, 2)
.Cells(5, CopyCol).Value = ListBox1.List(i, 3)
.Cells(7, CopyCol).Value = ListBox1.List(i, 4)
.Cells(8, CopyCol).Value = ListBox1.List(i, 5)
.Cells(9, CopyCol).Value = ListBox1.List(i, 6)
.Cells(10, CopyCol).Value = ListBox1.List(i, 7)
End With
CopyCol = CopyCol + 1
End If
Next i
OptionButton2.Value = True
ActiveSheet.Range("E12").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Su

--
Case

-----------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...nfo&userid=454
View this thread: http://www.excelforum.com/showthread.php?threadid=55110

Duplicate prevention from Listbox selections to worksheet
 

Private Sub cmdEnterSelection_Click()
Dim ACol As Long
Dim Rng1 As Range
Dim Rng2 As Range
Dim i As Long
Dim j As Long
Dim Entries As Long
Dim CopyCol As Long

Application.ScreenUpdating = False
ACol = Sheets("Takeoff").Range("AlphaCol").Column
'column to copy all formulas from
Set Rng1 = Sheets("Takeoff").Range("TakeOffHeaders") '8Rowsx240Columns
Set Rng2 = Sheets("Takeoff").Range("ScopeNames") '1Rowx240columns
TopRow of Rng1
Entries = Excel.WorksheetFunction.CountA(Rng2)
CopyCol = 1 + Entries
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
'Here is the logic I'm trying to code
If Application.Countif(rng2,Me.ListBox1.List(i,0)) = 0 then
Columns(ACol).Copy
Columns(ACol + CopyCol - 1).Select
ActiveSheet.Paste
With Rng1
.Cells(1, CopyCol).Value = ListBox1.List(i, 0)
.Cells(2, CopyCol).Value = ListBox1.List(i, 1)
.Cells(4, CopyCol).Value = ListBox1.List(i, 2)
.Cells(5, CopyCol).Value = ListBox1.List(i, 3)
.Cells(7, CopyCol).Value = ListBox1.List(i, 4)
.Cells(8, CopyCol).Value = ListBox1.List(i, 5)
.Cells(9, CopyCol).Value = ListBox1.List(i, 6)
.Cells(10, CopyCol).Value = ListBox1.List(i, 7)
End With
CopyCol = CopyCol + 1
End if
End If
Next i
OptionButton2.Value = True
ActiveSheet.Range("E12").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy

"Casey" wrote:


Hi everybody,
I have a UserForm with a Multi-column listbox set to multiselect. The
selected members from the listbox are then pasted to a range (Rng1).
The listbox has 8 command buttons which determine the RowSource.
The code works fine, but has a serious flaw. It is possible to select
and paste an item that already exists on the spreadsheet. I need a way
to intercept duplicates and not allow them to be entered into the
spreadsheet, and then allowing the remaining non-duplicates to go ahead
and be entered.
Using the variables in my code I need to check each ListBox1.List(i, 0)
against the entries already in Rng2. Could really use some help.

Here is My Code:

Private Sub cmdEnterSelection_Click()
Dim ACol As Long
Dim Rng1 As Range
Dim Rng2 As Range
Dim i As Long
Dim j As Long
Dim Entries As Long
Dim CopyCol As Long

Application.ScreenUpdating = False
ACol = Sheets("Takeoff").Range("AlphaCol").Column
'column to copy all formulas from
Set Rng1 = Sheets("Takeoff").Range("TakeOffHeaders") '8Rowsx240Columns
Set Rng2 = Sheets("Takeoff").Range("ScopeNames") '1Rowx240columns
TopRow of Rng1
Entries = Excel.WorksheetFunction.CountA(Rng2)
CopyCol = 1 + Entries
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
'Here is the logic I'm trying to code
'If Me.ListBox1.List(i,0)= Anything Already Rng2 Then Next (i)
Columns(ACol).Copy
Columns(ACol + CopyCol - 1).Select
ActiveSheet.Paste
With Rng1
.Cells(1, CopyCol).Value = ListBox1.List(i, 0)
.Cells(2, CopyCol).Value = ListBox1.List(i, 1)
.Cells(4, CopyCol).Value = ListBox1.List(i, 2)
.Cells(5, CopyCol).Value = ListBox1.List(i, 3)
.Cells(7, CopyCol).Value = ListBox1.List(i, 4)
.Cells(8, CopyCol).Value = ListBox1.List(i, 5)
.Cells(9, CopyCol).Value = ListBox1.List(i, 6)
.Cells(10, CopyCol).Value = ListBox1.List(i, 7)
End With
CopyCol = CopyCol + 1
End If
Next i
OptionButton2.Value = True
ActiveSheet.Range("E12").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=551109

Duplicate prevention from Listbox selections to worksheet
 

Tom,
I'm stunned. Your solution is perfect. I have spent 4 or 5 days chasing
Arrays, Collections and all manner of methods to adapt to this problem.
I still can't believe it was that simple (elegant). Thank you very
much.


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=551109