macro - Find duplicate in column - delete line

[skyport]

Hi everyone.

What I have is a situation where data is inputted into columns A to G. Each line of data will include a telephone number in Column D.

If possible, I would like to have a macro that searches the column D and when it finds a duplicate telephone number, it will delete the entire rows that contain the duplicate telephone numbers so those lines are completely gone leaving only the one line where that telephone number first appears in column D along with leaving of course all lines where that tel number was never listed in the first place.

Can this be done?

 

[skyport]

The code does the job. Here's some instant feedback. Just as with all the previous great help I have received here at Mr. Excel, probably just a minor tweak somewhere.

When I run the code, the system spins it's wheels going nowhere for about 2-3 minutes. then the excel page disappears but leaves the excel program itself open but in blank for about 5 minutes then the page returns with job done as planned and desired. Any additional thoughts on this?

 

[Rick Rothstein]

The code does the job. Here's some instant feedback. Just as with all the previous great help I have received here at Mr. Excel, probably just a minor tweak somewhere.

When I run the code, the system spins it's wheels going nowhere for about 2-3 minutes. then the excel page disappears but leaves the excel program itself open but in blank for about 5 minutes then the page returns with job done as planned and desired. Any additional thoughts on this?

I think this macro does what you want, see if it runs fast enough for you...

Sub MyDeleteCode()
  Dim X As Long, LastRow As Long, Data As Variant, Dict As Object
  Set Dict = CreateObject("Scripting.Dictionary")
  LastRow = Cells(Rows.Count, "D").End(xlUp).Row
  Data = Range("D2:D" & LastRow)
  On Error Resume Next
  For X = 1 To UBound(Data)
    Dict.Add Data(X, 1), CStr(Data(X, 1))
    If Err.Number Then
      Data(X, 1) = "#N/A"
      Err.Clear
    End If
  Next
  On Error GoTo 0
  Set Dict = Nothing
  Application.ScreenUpdating = False
  Range("D2").Resize(UBound(Data)) = Data
  Intersect(Columns("D").SpecialCells(xlConstants, xlErrors). _
            EntireRow, Columns("A:G")).Delete xlShiftUp
  Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

I think this macro does what you want, see if it runs fast enough for you...

Sub MyDeleteCode()
  Dim X As Long, LastRow As Long, Data As Variant, Dict As Object
  Set Dict = CreateObject("Scripting.Dictionary")
  LastRow = Cells(Rows.Count, "D").End(xlUp).Row
  Data = Range("D2:D" & LastRow)
  On Error Resume Next
  For X = 1 To UBound(Data)
    Dict.Add Data(X, 1), CStr(Data(X, 1))
    If Err.Number Then
      Data(X, 1) = "#N/A"
      Err.Clear
    End If
  Next
  On Error GoTo 0
  Set Dict = Nothing
  Application.ScreenUpdating = False
  Range("D2").Resize(UBound(Data)) = Data
  Intersect(Columns("D").SpecialCells(xlConstants, xlErrors). _
            EntireRow, Columns("A:G")).Delete xlShiftUp
  Application.ScreenUpdating = True
End Sub

I believe the following code will be notably faster than the code I posted above...

Sub MyDeleteCode()
  Dim R As Long, C As Long, Counter As Long, LastRow As Long
  Dim Data As Variant, Result As Variant, Dict As Object
  Set Dict = CreateObject("Scripting.Dictionary")
  LastRow = Cells(Rows.Count, "D").End(xlUp).Row
  Data = Range("A2:G" & LastRow).Formula
  ReDim Result(1 To UBound(Data), 1 To 7)
  On Error Resume Next
  For R = 1 To UBound(Data)
    Dict.Add Data(R, 1), CStr(Data(R, 1))
    If Err.Number Then
      Data(R, 1) = "#N/A"
      Err.Clear
    End If
  Next
  On Error GoTo 0
  Set Dict = Nothing
  For R = 1 To UBound(Data)
    If Data(R, 4) <> "#N/A" Then
      Counter = Counter + 1
      For C = 1 To 7
        Result(Counter, C) = Data(R, C)
      Next
    End If
  Next
  Range("A2:G2").Resize(UBound(Result)) = Result
End Sub

 

[skyport]

Good morning Rick, Always great to see you back for a good challenge and thanks again for the help with the previous thread.

On this one, I really like how the code totally seem to leave everything past column G untouched and unaffected because programming in that area will react to changes that occur in data in columns A through G which is meant to happen.

However, the code seem to not actually delete the cells within the A-G range but instead placed a " #N/A " in column A on those lines of data that should be gone.

 

[Joe4]

When I run the code, the system spins it's wheels going nowhere for about 2-3 minutes. then the excel page disappears but leaves the excel program itself open but in blank for about 5 minutes then the page returns with job done as planned and desired. Any additional thoughts on this?

Not sure why that would happen. May be a factor of the volume of data it is going through?

 

[Rick Rothstein]

Good morning Rick,

However, the code seem to not actually delete the cells within the A-G range but instead placed a " #N/A " in column A on those lines of data that should be gone.

Which of my two posted codes are you referring to?

Also, what version of Excel are you using and how many rows of data do you have?

 

[skyport]

Good morning Joe,

Currently it is dealing with around 120 cells in each column A-G of addresses and tel numbers and names. Shouldn't be too overwhelming.

 

[Joe4]

Currently it is dealing with around 120 cells in each column A-G of addresses and tel numbers and names. Shouldn't be too overwhelming.

No, that shouldn't be an issue. You may have something else going on there.
Is there other VBA on the workbook? Maybe some automated Event Procedure code that is being triggered by the code I wrote.

 

[skyport]

Rick,

The version I tried was the second one. I will try the first one now and see any difference. The current number of lines is 120 but that increases every week.

 

[skyport]

Joe, there are other macros to the sheet however, nothing automated. they all need to be run manually.