CODEWITHSUNDEEP
excel
Chris Muench
Chris Muench

Reputation: 18338

Remove duplicate rows based on value of cell in column

I have the following script that works well in google docs --> sheets. It doesn't work well with a lot of rows. I am guessing because of the array that keeps getting bigger that tracks the values.

I need a script I can run in MS EXCEL that will remove rows that have a duplicate value in a column. (Unless the column is "")

Google docs script that works for small files:

function removeDuplicates()
{
  var s = SpreadsheetApp.getActiveSheet();
  var c = Browser.inputBox("Please", "Type in the column name (e.g.: A, B, etc.)", Browser.Buttons.OK_CANCEL);
  var r, v;
  var aValues = [];
  try
  {
    if(c != "cancel")
    {
      r = 2; // first row is row two
      while (r <= s.getLastRow())
      {
        v = s.getRange(c + r).getValue();
        if(v != "")
        {
          if(aValues.indexOf(v) == -1)
          {
            aValues.push(v);
          }
          else
          {
            s.deleteRow(r);
            continue;
          }
        }
        r++;
      }
      Browser.msgBox("Duplicates removed!");
    }
  } catch (e) {Browser.msgBox("Error Alert:", e.message, Browser.Buttons.OK);}
}

Any help would be appreciated.

Upvotes: 0

Views: 1638

Answers (1)

user4039065
user4039065

Reputation:

Here is something that seems to fit the bill.

Sub dedupe_ignore_blanks()
    Dim r As Long, v As Long, vVALs As Variant, sCOL As String
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With ActiveSheet.Cells(1, 1).CurrentRegion
        sCOL = "B"
        sCOL = Application.InputBox("Type in the column name (e.g.: A, B, etc.)", _
            "Please", sCOL, 250, 75, "", , 2)
        If CBool(Len(sCOL)) And sCOL <> "False" Then
            For r = .Rows.Count To 2 Step -1
                If Application.CountIf(.Columns(sCOL), .Cells(r, sCOL).Value) > 1 Then _
                    .Rows(r).EntireRow.Delete
            Next r
        End If
    End With
FallThrough:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

I gathered from your code snippet that you had a header row in the data row 1. The Application.CountIF does not count blank cells.

Upvotes: 1

Related Questions