Deleting duplicate entries
 

I am wondering if anyone can help. I have this VB script below tha
deleted duplicates. But I want to know how to make it only look i
column F and then delete any dups it finds.

Can anyone help, please?

Sub DeleteDuplicatesAnyCol()
Dim sht As Worksheet, sht2 As Worksheet
Dim rng As Range
Dim fndrng As Range
Dim mycell
Dim lookupcol As Integer, i As Integer
lookupcol = 1 ' for example Column E - replace with 1 if you want to g
with Column A
Set sht = ActiveSheet
Set rng = sht.Range(sht.Cells(1, lookupcol), sht.Cells(65536
lookupcol).End(xlUp))
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sht2 = Worksheets.Add
sht2.Name = "Deleted"
i = 1
sht.Activate
For Each mycell In rng.Cells
Set fndrng = rng.Find(mycell.Value, mycell, xlValues, xlWhole)
Do Until fndrng.Row = mycell.Row
sht.Rows(fndrng.Row).Copy Destination:=sht2.Rows(i)
i = i + 1
sht.Rows(fndrng.Row).Delete
Set fndrng = rng.FindNext(mycell)
Loop
Next mycell
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Su

--
Message posted from http://www.ExcelForum.com

Deleting duplicate entries
 

Also, I need to make sure that it still deletes the whole entry

--
Message posted from http://www.ExcelForum.com

Deleting duplicate entries
 

Change LookupCol = 5

Sub DeleteDuplicatesAnyCol()
Dim sht As Worksheet, sht2 As Worksheet
Dim rng As Range
Dim fndrng As Range
Dim mycell
Dim lookupcol As Integer, i As Integer
lookupcol = 5 ' for example Column F -
' replace with 1 if you want
' to go with Column A
Set sht = ActiveSheet
Set rng = sht.Range(sht.Cells(1, lookupcol), sht.Cells(65536,
lookupcol).End(xlUp))
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sht2 = Worksheets.Add
sht2.Name = "Deleted"
i = 1
sht.Activate
For Each mycell In rng.Cells
Set fndrng = rng.Find(mycell.Value, mycell, xlValues, xlWhole)
Do Until fndrng.Row = mycell.Row
sht.Rows(fndrng.Row).Copy Destination:=sht2.Rows(i)
i = i + 1
sht.Rows(fndrng.Row).Delete
Set fndrng = rng.FindNext(mycell)
Loop
Next mycell
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


--
Regards,
Tom Ogilvy

"jmosk " wrote in message
...
I am wondering if anyone can help. I have this VB script below that
deleted duplicates. But I want to know how to make it only look in
column F and then delete any dups it finds.

Can anyone help, please?

Sub DeleteDuplicatesAnyCol()
Dim sht As Worksheet, sht2 As Worksheet
Dim rng As Range
Dim fndrng As Range
Dim mycell
Dim lookupcol As Integer, i As Integer
lookupcol = 1 ' for example Column E - replace with 1 if you want to go
with Column A
Set sht = ActiveSheet
Set rng = sht.Range(sht.Cells(1, lookupcol), sht.Cells(65536,
lookupcol).End(xlUp))
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sht2 = Worksheets.Add
sht2.Name = "Deleted"
i = 1
sht.Activate
For Each mycell In rng.Cells
Set fndrng = rng.Find(mycell.Value, mycell, xlValues, xlWhole)
Do Until fndrng.Row = mycell.Row
sht.Rows(fndrng.Row).Copy Destination:=sht2.Rows(i)
i = i + 1
sht.Rows(fndrng.Row).Delete
Set fndrng = rng.FindNext(mycell)
Loop
Next mycell
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


---
Message posted from http://www.ExcelForum.com/

Deleting duplicate entries
 

If it worked as you wanted before, it should still do so.

--
Regards,
Tom Ogilvy


"jmosk " wrote in message
...
Also, I need to make sure that it still deletes the whole entry.


---
Message posted from http://www.ExcelForum.com/

Deleting duplicate entries
 

I still don't know how to execute the script on Column F though.

Just putting 6 in place of 1 in lookupcol=

gives me a runtime error


---
Message posted from http://www.ExcelForum.com/

Deleting duplicate entries
 

Sub DeleteDuplicatesAnyCol()
Dim sht As Worksheet, sht2 As Worksheet
Dim rng As Range
Dim fndrng As Range
Dim mycell
Dim lookupcol As Integer, i As Integer
lookupcol = 6 ' for example Column F -
' replace with 1 if you want
' to go with Column A
Set sht = ActiveSheet
Set rng = sht.Range(sht.Cells(1, lookupcol), _
sht.Cells(65536, lookupcol).End(xlUp))
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sht2 = Worksheets.Add
sht2.Name = "Deleted"
i = 1
sht.Activate
For Each mycell In rng.Cells
Set fndrng = rng.Find(mycell.Value, mycell, xlValues, xlWhole)
Do Until fndrng.Row = mycell.Row
sht.Rows(fndrng.Row).Copy Destination:=sht2.Rows(i)
i = i + 1
sht.Rows(fndrng.Row).Delete
Set fndrng = rng.FindNext(mycell)
Loop
Next mycell
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Worked fine for me. (I made no modification except changed 5 to 6).

I did break on long line into 2 with a line continuation character, Maybe
you were the victim of wordwrap if you copied it from the email.

--

Regards,
Tom Ogilvy


"jmosk " wrote in message
...
I still don't know how to execute the script on Column F though.

Just putting 6 in place of 1 in lookupcol=

gives me a runtime error


---
Message posted from http://www.ExcelForum.com/

Deleting duplicate entries
 

i can set the value to 1-5and it works fine. but not 6 or higher withou
an error.

I dont get it.

--
Message posted from http://www.ExcelForum.com