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