PDA

View Full Version : Solved: Delete duplicate data in a Column



parscon
02-11-2012, 01:08 AM
I Have a Problem with this VBA code , i want to delete just duplicate data on Column B , just Column B . but this code delete row also .
that beter i write i want to remove duplicate just i 1 Column and also remove the blank cell on that column alo .

Please help me .




Dim x As Long
Dim LastRow As Long
LastRow = Range("B65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B1:B" & x), Range("B" & x).Text) > 1 Then
Range("B" & x).EntireRow.Delete
End If
Next x

shrivallabha
02-11-2012, 02:44 AM
This part deletes entire row:
Range("B" & x).EntireRow.Delete
so change it to:
Range("B" & x).Delete

parscon
02-11-2012, 02:51 AM
Thank you for your help , it is ok but there is 1 problem and 1 question .

I have A - B - C - D column when use your code all duplicate data on column B romoved but the latest data of column C add to end of column B . where is the probme?

if i want to use this code for A- B - C - D column that mean remove duplicate data of each column , please help me how can do it .

shrivallabha
02-11-2012, 02:58 AM
This should settle the first part:
Range("B" & x").Delete Shift:=xlUp

I am little unclear about your requirement:

Do you mean check for duplicates in each column separately and deleting them?
e.g. Duplicate found in B2 so delete B2 only.

Or When duplicate is found in column B then delete four cells together?
e.g. Duplicate found in B2 so delete A2:D2?

parscon
02-11-2012, 03:00 AM
Yes , I want check for duplicates in each column separately and deleting them.

Thank you very much for your big help .

shrivallabha
02-11-2012, 03:09 AM
Then this should work:
Dim i As Integer
Dim x As Long
Dim LastRow As Long
Application.ScreenUpdating = False
For i = 1 To 4
LastRow = Cells(65536, i).End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.CountIf(Range(Cells(1, i), Cells(x, i)), Cells(x, i).Value) > 1 Then
Cells(x, i).Delete Shift:=xlUp
End If
Next x
Next i
Application.ScreenUpdating = True

parscon
02-11-2012, 03:18 AM
You are the best mam . you help me so much and thank you for your help .

parscon
02-11-2012, 03:20 AM
just my latest question , could please add a code to remove blank celll also ?

shrivallabha
02-11-2012, 03:25 AM
OK. I am assuming that there are no cells with formulas that give blanks.
Dim i As Integer
Dim x As Long
Dim LastRow As Long
For i = 1 To 4
LastRow = Cells(65536, i).End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.CountIf(Range(Cells(1, i), Cells(x, i)), Cells(x, i).Value) > 1 Then
Cells(x, i).Delete Shift:=xlUp
End If
Next x
On Error Resume Next
Range(Cells(1, i), Cells(LastRow, i)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0
Next i

parscon
02-11-2012, 03:36 AM
Thank you So much For your Helo Man .
Have a Good Day .

parscon
02-11-2012, 03:40 AM
Fr this one please add the code to remove blank cell after delete, :bow:

Pleaseeeeeeeeee



Dim x As Long
Dim LastRow As Long
LastRow = Range("B65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B1:B" & x), Range("B" & x).Text) > 1 Then
Range("B" & x).Delete Shift:=xlUp
End If
Next x

parscon
02-11-2012, 04:23 AM
it is done .

Thank you very much shrivallabha






Dim x As Long
Dim LastRow As Long
LastRow = Range("B65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B1:B" & x), Range("B" & x).Text) > 1 Then
Range("B" & x).Delete Shift:=xlUp
End If
Next x
On Error Resume Next
Range(Cells(1, "B"), Cells(LastRow, "B")).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error Goto 0
Next B