[makrumahesh]

Hello,

Please help me...

I wanted to search for the duplicate numbers in the field 2 and delete the rows except only one.
I made this macro below but I wanted the macro to select the field 1 criteria as "internet" and field 2 criteria automatically.. Please help me.

voice 12177880 02/02/2012 8:43:42
voice 12177880 09/02/2012 9:36:08
voice 12177880 09/02/2012 19:26:13
sms 12177880 09/02/2012 9:46:13
Internet 12177880 11/02/2012 12:24:10
Internet 12177880 07/02/2012 10:38:23
Internet 12177880 14/02/2012 20:00:08
Internet 12177880 15/02/2012 9:43:16
voice 12178243 02/02/2012
voice 12178243 31/01/2012
voice 12178243 31/01/2012
voice 12178243 31/01/2012
voice 12178243 31/01/2012
sms 12178243 10/02/2012
sms 12178243 05/02/2012
sms 12178243 05/02/2012
sms 12178243 05/02/2012
sms 12178243 05/02/2012
sms 12178243 05/02/2012
sms 12178243 12/02/2012
sms 12178243 12/02/2012
sms 12178243 09/02/2012
sms 12178243 31/01/2012
sms 12178243 31/01/2012
sms 12178243 31/01/2012
sms 12178243 31/01/2012
sms 12178243 31/01/2012
Internet 12178243 04/02/2012
Internet 12178243 11/02/2012
Internet 12178243 11/02/2012
Internet 12178243 10/02/2012

leave voice and sms. I need the change only in "internet". I wanted to keep only one row of internet with same number in the second colunm.


Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+m
'
ActiveSheet.Range("$A:$H").AutoFilter Field:=1, Criteria1:= _
"Internet"
ActiveSheet.Range("$A:$H").AutoFilter Field:=2, Criteria1:=
"12170145"
Dim Lastrow As Long, r As Long
Application.ScreenUpdating = False
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
For r = Lastrow To 2 Step -1
If Range("A" & r).Value = Range("A" & r - 1).Value Then
Range("B" & r - 1).Value = Range("B" & r - 1).Value
Rows(r).Delete xlShiftUp
End If
Next r
ActiveSheet.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True

Columns("B:B").Select
Selection.ColumnWidth = 15
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

End Sub