Duplicates in column

B

browie

Hi all I have a userform which I have linked a combobox upto column "A" in
my worksheet.
What I have done is place some code that copies the information in this box
when exited into two postions in the workbook.

The problem I am having is when something new is added it is ok and it just
adds to the list, but when an older item is used it places it into the list
aswell so I then start having duplicates.
Is there a code I can use on the combobox to stop this from occuring?

If not how can I change this code to search the whole column and remove the
duplicates.


This is the code I use to put the information into the worksheets, It is
the section for sheet150 which is called "dayoptions" where I am having the
problem with duplicates.

Private Sub CommandButton1_Click()

R = 46
ActiveSheet.Cells(R, 2).Value = UCase(ComboBox1.Text)
R = 46
ActiveSheet.Cells(R, 3).Value = UCase(TextBox1.Text)
R = 46
ActiveSheet.Cells(R, 4).Value = UCase(TextBox4.Text)
R = 46
ActiveSheet.Cells(R, 5).Value = UCase(TextBox6.Text)

R = 46
ActiveSheet.Cells(R, 6).Value = UCase(ComboBox2.Text)
R = 46
ActiveSheet.Cells(R, 7).Value = UCase(TextBox2.Text)
Sheet150.Range("A1").Insert
R = 46
ActiveSheet.Cells(R, 8).Value = UCase(TextBox3.Text)
R = 46
ActiveSheet.Cells(R, 9).Value = UCase(TextBox5.Text)

R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox1.Text)
Sheet150.Range("A1").Insert
R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox2.Text)
With Worksheets("dayoptions")
.Range("A1:A65536").Sort Key1:=.Range("A1")
End With

Unload Me
DAYOPTIONSDAYS.Show

end sub

This is the code I use to remove the duplicate as you can see it is very
complicated, there must be an easier way.

Sub SHUTDOWN()
'
' SHUTDOWN Macro
' Macro recorded 19/08/2005 by Greg
'

'
Sheets("DAYOPTIONS").Select
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B1").Select
ActiveCell.FormulaR1C1 = "=C[-1]+COUNTIF(C[-1],RC[-1])"
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("B1").Select
Selection.Copy
Range("B2:B500").Select
ActiveSheet.Paste
Range("C1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,""YES"","""")"
Range("C1").Select
Selection.Copy
Range("C2:C500").Select
ActiveSheet.Paste
Call TRY

End Sub
Sub TRY()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 3
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "yes" Then
cell.EntireRow.Delete
End If
Next
Call TRYER

End Sub
Sub TRYER()
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 2
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "0" Then
cell.EntireRow.Delete
End If
Next

Columns("B:C").Select
Range("B247").Activate
Selection.ClearContents
Range("A247").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

Sorry for the long question.
Thanks in advance

Greg
 
N

Norman Jones

Hi Greg,

Why not use the Advanced Filter | Unique Records and use the filtered list
as your source?


---
Regards,
Norman



browie said:
Hi all I have a userform which I have linked a combobox upto column "A" in
my worksheet.
What I have done is place some code that copies the information in this
box when exited into two postions in the workbook.

The problem I am having is when something new is added it is ok and it
just adds to the list, but when an older item is used it places it into
the list aswell so I then start having duplicates.
Is there a code I can use on the combobox to stop this from occuring?

If not how can I change this code to search the whole column and remove
the duplicates.


This is the code I use to put the information into the worksheets, It is
the section for sheet150 which is called "dayoptions" where I am having
the problem with duplicates.

Private Sub CommandButton1_Click()

R = 46
ActiveSheet.Cells(R, 2).Value = UCase(ComboBox1.Text)
R = 46
ActiveSheet.Cells(R, 3).Value = UCase(TextBox1.Text)
R = 46
ActiveSheet.Cells(R, 4).Value = UCase(TextBox4.Text)
R = 46
ActiveSheet.Cells(R, 5).Value = UCase(TextBox6.Text)

R = 46
ActiveSheet.Cells(R, 6).Value = UCase(ComboBox2.Text)
R = 46
ActiveSheet.Cells(R, 7).Value = UCase(TextBox2.Text)
Sheet150.Range("A1").Insert
R = 46
ActiveSheet.Cells(R, 8).Value = UCase(TextBox3.Text)
R = 46
ActiveSheet.Cells(R, 9).Value = UCase(TextBox5.Text)

R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox1.Text)
Sheet150.Range("A1").Insert
R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox2.Text)
With Worksheets("dayoptions")
.Range("A1:A65536").Sort Key1:=.Range("A1")
End With

Unload Me
DAYOPTIONSDAYS.Show

end sub

This is the code I use to remove the duplicate as you can see it is very
complicated, there must be an easier way.

Sub SHUTDOWN()
'
' SHUTDOWN Macro
' Macro recorded 19/08/2005 by Greg
'

'
Sheets("DAYOPTIONS").Select
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B1").Select
ActiveCell.FormulaR1C1 = "=C[-1]+COUNTIF(C[-1],RC[-1])"
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("B1").Select
Selection.Copy
Range("B2:B500").Select
ActiveSheet.Paste
Range("C1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,""YES"","""")"
Range("C1").Select
Selection.Copy
Range("C2:C500").Select
ActiveSheet.Paste
Call TRY

End Sub
Sub TRY()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 3
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "yes" Then
cell.EntireRow.Delete
End If
Next
Call TRYER

End Sub
Sub TRYER()
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 2
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "0" Then
cell.EntireRow.Delete
End If
Next

Columns("B:C").Select
Range("B247").Activate
Selection.ClearContents
Range("A247").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

Sorry for the long question.
Thanks in advance

Greg
Click to expand...
 
B

browie

Thanks Norman
will give it a go just did not think of that at all.

Greg

Norman Jones said:
Hi Greg,

Why not use the Advanced Filter | Unique Records and use the filtered
list as your source?


---
Regards,
Norman



browie said:
Hi all I have a userform which I have linked a combobox upto column "A"
in my worksheet.
What I have done is place some code that copies the information in this
box when exited into two postions in the workbook.

The problem I am having is when something new is added it is ok and it
just adds to the list, but when an older item is used it places it into
the list aswell so I then start having duplicates.
Is there a code I can use on the combobox to stop this from occuring?

If not how can I change this code to search the whole column and remove
the duplicates.


This is the code I use to put the information into the worksheets, It is
the section for sheet150 which is called "dayoptions" where I am having
the problem with duplicates.

Private Sub CommandButton1_Click()

R = 46
ActiveSheet.Cells(R, 2).Value = UCase(ComboBox1.Text)
R = 46
ActiveSheet.Cells(R, 3).Value = UCase(TextBox1.Text)
R = 46
ActiveSheet.Cells(R, 4).Value = UCase(TextBox4.Text)
R = 46
ActiveSheet.Cells(R, 5).Value = UCase(TextBox6.Text)

R = 46
ActiveSheet.Cells(R, 6).Value = UCase(ComboBox2.Text)
R = 46
ActiveSheet.Cells(R, 7).Value = UCase(TextBox2.Text)
Sheet150.Range("A1").Insert
R = 46
ActiveSheet.Cells(R, 8).Value = UCase(TextBox3.Text)
R = 46
ActiveSheet.Cells(R, 9).Value = UCase(TextBox5.Text)

R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox1.Text)
Sheet150.Range("A1").Insert
R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox2.Text)
With Worksheets("dayoptions")
.Range("A1:A65536").Sort Key1:=.Range("A1")
End With

Unload Me
DAYOPTIONSDAYS.Show

end sub

This is the code I use to remove the duplicate as you can see it is very
complicated, there must be an easier way.

Sub SHUTDOWN()
'
' SHUTDOWN Macro
' Macro recorded 19/08/2005 by Greg
'

'
Sheets("DAYOPTIONS").Select
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B1").Select
ActiveCell.FormulaR1C1 = "=C[-1]+COUNTIF(C[-1],RC[-1])"
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("B1").Select
Selection.Copy
Range("B2:B500").Select
ActiveSheet.Paste
Range("C1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,""YES"","""")"
Range("C1").Select
Selection.Copy
Range("C2:C500").Select
ActiveSheet.Paste
Call TRY

End Sub
Sub TRY()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 3
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "yes" Then
cell.EntireRow.Delete
End If
Next
Call TRYER

End Sub
Sub TRYER()
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 2
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "0" Then
cell.EntireRow.Delete
End If
Next

Columns("B:C").Select
Range("B247").Activate
Selection.ClearContents
Range("A247").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

Sorry for the long question.
Thanks in advance

Greg
Click to expand...
Click to expand...
 
N

Nigel

I would suggest that before you add the item to the list you check if it is
there already, that way you list should remain duplicate free without having
to clear up afterwards. If you need to sort the lsit do that at the same
time. So the pseudo code would be....

combox value is entered then
check is value in list
if not add it to the end, sort the list, and refresh the combo box, set
index to value entered

If you wish to pursue this let me know and I'll provide some code.


--
Cheers
Nigel



browie said:
Hi all I have a userform which I have linked a combobox upto column "A" in
my worksheet.
What I have done is place some code that copies the information in this box
when exited into two postions in the workbook.

The problem I am having is when something new is added it is ok and it just
adds to the list, but when an older item is used it places it into the list
aswell so I then start having duplicates.
Is there a code I can use on the combobox to stop this from occuring?

If not how can I change this code to search the whole column and remove the
duplicates.


This is the code I use to put the information into the worksheets, It is
the section for sheet150 which is called "dayoptions" where I am having the
problem with duplicates.

Private Sub CommandButton1_Click()

R = 46
ActiveSheet.Cells(R, 2).Value = UCase(ComboBox1.Text)
R = 46
ActiveSheet.Cells(R, 3).Value = UCase(TextBox1.Text)
R = 46
ActiveSheet.Cells(R, 4).Value = UCase(TextBox4.Text)
R = 46
ActiveSheet.Cells(R, 5).Value = UCase(TextBox6.Text)

R = 46
ActiveSheet.Cells(R, 6).Value = UCase(ComboBox2.Text)
R = 46
ActiveSheet.Cells(R, 7).Value = UCase(TextBox2.Text)
Sheet150.Range("A1").Insert
R = 46
ActiveSheet.Cells(R, 8).Value = UCase(TextBox3.Text)
R = 46
ActiveSheet.Cells(R, 9).Value = UCase(TextBox5.Text)

R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox1.Text)
Sheet150.Range("A1").Insert
R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox2.Text)
With Worksheets("dayoptions")
.Range("A1:A65536").Sort Key1:=.Range("A1")
End With

Unload Me
DAYOPTIONSDAYS.Show

end sub

This is the code I use to remove the duplicate as you can see it is very
complicated, there must be an easier way.

Sub SHUTDOWN()
'
' SHUTDOWN Macro
' Macro recorded 19/08/2005 by Greg
'

'
Sheets("DAYOPTIONS").Select
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B1").Select
ActiveCell.FormulaR1C1 = "=C[-1]+COUNTIF(C[-1],RC[-1])"
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("B1").Select
Selection.Copy
Range("B2:B500").Select
ActiveSheet.Paste
Range("C1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,""YES"","""")"
Range("C1").Select
Selection.Copy
Range("C2:C500").Select
ActiveSheet.Paste
Call TRY

End Sub
Sub TRY()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 3
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "yes" Then
cell.EntireRow.Delete
End If
Next
Call TRYER

End Sub
Sub TRYER()
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 2
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "0" Then
cell.EntireRow.Delete
End If
Next

Columns("B:C").Select
Range("B247").Activate
Selection.ClearContents
Range("A247").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

Sorry for the long question.
Thanks in advance

Greg
Click to expand...
 
B

browie

Thanks Nigel
I would like some help with that just not sure how to?

Greg
Nigel said:
I would suggest that before you add the item to the list you check if it is
there already, that way you list should remain duplicate free without
having
to clear up afterwards. If you need to sort the lsit do that at the same
time. So the pseudo code would be....

combox value is entered then
check is value in list
if not add it to the end, sort the list, and refresh the combo box, set
index to value entered

If you wish to pursue this let me know and I'll provide some code.


--
Cheers
Nigel



browie said:
Hi all I have a userform which I have linked a combobox upto column "A"
in
my worksheet.
What I have done is place some code that copies the information in this box
when exited into two postions in the workbook.

The problem I am having is when something new is added it is ok and it just
adds to the list, but when an older item is used it places it into the list
aswell so I then start having duplicates.
Is there a code I can use on the combobox to stop this from occuring?

If not how can I change this code to search the whole column and remove the
duplicates.


This is the code I use to put the information into the worksheets, It is
the section for sheet150 which is called "dayoptions" where I am having the
problem with duplicates.

Private Sub CommandButton1_Click()

R = 46
ActiveSheet.Cells(R, 2).Value = UCase(ComboBox1.Text)
R = 46
ActiveSheet.Cells(R, 3).Value = UCase(TextBox1.Text)
R = 46
ActiveSheet.Cells(R, 4).Value = UCase(TextBox4.Text)
R = 46
ActiveSheet.Cells(R, 5).Value = UCase(TextBox6.Text)

R = 46
ActiveSheet.Cells(R, 6).Value = UCase(ComboBox2.Text)
R = 46
ActiveSheet.Cells(R, 7).Value = UCase(TextBox2.Text)
Sheet150.Range("A1").Insert
R = 46
ActiveSheet.Cells(R, 8).Value = UCase(TextBox3.Text)
R = 46
ActiveSheet.Cells(R, 9).Value = UCase(TextBox5.Text)

R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox1.Text)
Sheet150.Range("A1").Insert
R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox2.Text)
With Worksheets("dayoptions")
.Range("A1:A65536").Sort Key1:=.Range("A1")
End With

Unload Me
DAYOPTIONSDAYS.Show

end sub

This is the code I use to remove the duplicate as you can see it is very
complicated, there must be an easier way.

Sub SHUTDOWN()
'
' SHUTDOWN Macro
' Macro recorded 19/08/2005 by Greg
'

'
Sheets("DAYOPTIONS").Select
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B1").Select
ActiveCell.FormulaR1C1 = "=C[-1]+COUNTIF(C[-1],RC[-1])"
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("B1").Select
Selection.Copy
Range("B2:B500").Select
ActiveSheet.Paste
Range("C1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,""YES"","""")"
Range("C1").Select
Selection.Copy
Range("C2:C500").Select
ActiveSheet.Paste
Call TRY

End Sub
Sub TRY()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 3
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "yes" Then
cell.EntireRow.Delete
End If
Next
Call TRYER

End Sub
Sub TRYER()
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 2
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "0" Then
cell.EntireRow.Delete
End If
Next

Columns("B:C").Select
Range("B247").Activate
Selection.ClearContents
Range("A247").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

Sorry for the long question.
Thanks in advance

Greg
Click to expand...
Click to expand...
 
S

STEVE BELL

Not sure where your "value" is coming from, or what column/cell it is going
to. But in general

If Worksheetfunction.Countif(Sheets("MySheet"),Range("A:A"),"value") = 0
then
' code to add item
Else msgbox "Item already exists"
' what do you want to do
End If

--
steveB

Remove "AYN" from email to respond
browie said:
Thanks Nigel
I would like some help with that just not sure how to?

Greg
Nigel said:
I would suggest that before you add the item to the list you check if it
is
there already, that way you list should remain duplicate free without
having
to clear up afterwards. If you need to sort the lsit do that at the same
time. So the pseudo code would be....

combox value is entered then
check is value in list
if not add it to the end, sort the list, and refresh the combo box, set
index to value entered

If you wish to pursue this let me know and I'll provide some code.


--
Cheers
Nigel



browie said:
Hi all I have a userform which I have linked a combobox upto column "A"
in
my worksheet.
What I have done is place some code that copies the information in this box
when exited into two postions in the workbook.

The problem I am having is when something new is added it is ok and it just
adds to the list, but when an older item is used it places it into the list
aswell so I then start having duplicates.
Is there a code I can use on the combobox to stop this from occuring?

If not how can I change this code to search the whole column and remove the
duplicates.


This is the code I use to put the information into the worksheets, It
is
the section for sheet150 which is called "dayoptions" where I am having the
problem with duplicates.

Private Sub CommandButton1_Click()

R = 46
ActiveSheet.Cells(R, 2).Value = UCase(ComboBox1.Text)
R = 46
ActiveSheet.Cells(R, 3).Value = UCase(TextBox1.Text)
R = 46
ActiveSheet.Cells(R, 4).Value = UCase(TextBox4.Text)
R = 46
ActiveSheet.Cells(R, 5).Value = UCase(TextBox6.Text)

R = 46
ActiveSheet.Cells(R, 6).Value = UCase(ComboBox2.Text)
R = 46
ActiveSheet.Cells(R, 7).Value = UCase(TextBox2.Text)
Sheet150.Range("A1").Insert
R = 46
ActiveSheet.Cells(R, 8).Value = UCase(TextBox3.Text)
R = 46
ActiveSheet.Cells(R, 9).Value = UCase(TextBox5.Text)

R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox1.Text)
Sheet150.Range("A1").Insert
R = 1
Sheet150.Cells(R, 1).Value = UCase(ComboBox2.Text)
With Worksheets("dayoptions")
.Range("A1:A65536").Sort Key1:=.Range("A1")
End With

Unload Me
DAYOPTIONSDAYS.Show

end sub

This is the code I use to remove the duplicate as you can see it is very
complicated, there must be an easier way.

Sub SHUTDOWN()
'
' SHUTDOWN Macro
' Macro recorded 19/08/2005 by Greg
'

'
Sheets("DAYOPTIONS").Select
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B1").Select
ActiveCell.FormulaR1C1 = "=C[-1]+COUNTIF(C[-1],RC[-1])"
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("B1").Select
Selection.Copy
Range("B2:B500").Select
ActiveSheet.Paste
Range("C1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,""YES"","""")"
Range("C1").Select
Selection.Copy
Range("C2:C500").Select
ActiveSheet.Paste
Call TRY

End Sub
Sub TRY()
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 3
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "yes" Then
cell.EntireRow.Delete
End If
Next
Call TRYER

End Sub
Sub TRYER()
Columns("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Dim rng As Range, cell As Range, col As Long
Dim rw As Long
col = 2
rw = 1
With Worksheets("DAYOPTIONS")
Set rng = .Range(.Cells(1, col), .Cells(Rows.Count, col).End(xlUp))
End With
For Each cell In rng
If LCase(cell.Value) = "0" Then
cell.EntireRow.Delete
End If
Next

Columns("B:C").Select
Range("B247").Activate
Selection.ClearContents
Range("A247").Select
ActiveWindow.SmallScroll Down:=-24
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

Sorry for the long question.
Thanks in advance

Greg
Click to expand...
Click to expand...
Click to expand...
 
A

agarwaldvk

Greg

You might want to try this :-

Create a 'Collection' object. You can add items to a collection object
using the following :-

Object.Add item, key, before, after

Use this to add items to this collection. The argument 'key' needs to
be UNIQUE.

You must have the 'On Error Resume Next' statement in your sub
procedure.

When your procedure attempts to add the item which already exists in
the collecltion object, it will generate an error. Use this error step
to ignore adding this item to the list.

If you have the book 'Excel 2000 Power Programming using VBA' by John
Walkenbach, check under Userform Examples.


Best regards


Deepak Agarwal
 

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

Similar Threads

Run macro on all files in a specific folder 3
type mismatch error in macro in excel 0
Shed some light on this WS_Calculate macro. 3
Range.Find problem 3
Macro to delete row if cells greater than certain value 1
Code execution is correct but generates Error :The file you aretrying to open is in a different form 3
Count Duplicates 8
Duplicates 0

Top