Not allow duplicates from listbox to Worksheet

C

Casey

Hi,
I have a UserForm that allows multi-selection from a listbox and
CommandButton to send the selected items to the worksheet.
The UserForm is Modeless and has several CommandButtons to change th
rowsource of the listbox. It is now possible to select and enter th
same item twice into the sheet, which would create an error in th
sheet not easily found.
So I need to be able to check that a listbox selection is not
duplicate already on the sheet and prevent it from being sent to th
sheet. Ideally, any remaining non-duplicate items would be sent to th
sheet only the duplicate stopped.
My current code has a MsgBox, but I put that in the code as a way t
alert me during design. I would love to have this all in th
background, without any notification.
My current Code generates a 424 run-time error Object Required. I hav
run out of ideas how to fix this.

Here is the Code:

Option Explicit

Private Sub cmdEnterSelection_Click()
Dim ACol As Long
Dim Rng1 As Range
Dim rng 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
Set Rng1 = Sheets("Takeoff").Range("TakeOffHeaders")
Set rng = Sheets("Takeoff").Range("ScopeNames")
Entries = Excel.WorksheetFunction.CountA(rng)
CopyCol = 1 + Entries
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
Columns(ACol).Copy
Columns(ACol + CopyCol - 1).Select
ActiveSheet.Paste
If WorksheetFunction.CountIf(Range("ItemDescripTO"), _
ListBox1.List(i, 0).Value) = 0 Then '<<< 424 Error Hit
Here
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
Else
MsgBox "One of your selections is a" _
& " duplicate."
End If
CopyCol = CopyCol + 1

End If
Next i
Entries = Excel.WorksheetFunction.CountA(rng)
CopyCol = 1 + Entries
Columns(ACol + CopyCol).Clear
OptionButton2.Value = True
ActiveSheet.Range("E12").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Su
 
C

Casey

Great VBA Gurus,
Please take a look at my post from yesterday. I have searched in the
archives until my eyes are crossed and can't find anything new to try.
The code I posted yesterday is still the best I can come up with.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top