Search code examples
excelvbaduplicatesinsert-update

Excel VBA Remove duplicates in a range


I'm struggling with the updating of a number of sheets that hold master data.

The user can update the register ("TK_Register") with a new item or modify an existing item on the ("EditEX") sheet. Data on the EditEx sheet is stored maintained at C32:P56 and saved on the next empty row of the TK_Register Sheet (Columns A to N)

Using a different code, I can recall all specific rows based on a reference number (stored on EditEX sheet in cells O32:O56 and on the TK_Register sheet in column M).

On running this code,

  • excel takes all data from EditEx sheet C32:P56
  • Pastes this data to the next empty row on TK_Register Sheet
  • Auto filters based on column "N" for "NO" (i.e. don't need to keep this row)
  • Deletes the rows that where filtered (these are rows that have not been used and contain Default data)
  • Unfilters the data

This is where I get an issue. This adding all data to the TK_Register sheet includes new Items as well as previous items that have been updated. As we need to make regular additions, updates and changes, when we need to edit it again we only want to see the most recent line items appear on the EditEx sheet.

The user can then make changes to any of the recalled rows and/or add a new one.

My below code only works where the last row reference number (column M) is duplicated. If more than 1 row is being added, it finds no duplicates. I know I'm going through this the long way, but any ideas how I can have it search each reference number (column M) being pasted (there will be multiple rows) if found update that row with new data, if not found, add to the next available rows.

    Sub SaveUpdatedRec()

        Dim rng4 As Range
        Set rng4 = Sheets("EditEx").Range("C32:P56")
        Sheets("TK_Register").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rng4.Rows.Count, rng4.Columns.Count).Cells.Value = rng4.Cells.Value
        Sheets("TK_Register").Range("A1:N1000").AutoFilter field:=14, Criteria1:="NO"
        Application.DisplayAlerts = False
        Sheets("TK_Register").Range("A2:N1000").SpecialCells(xlCellTypeVisible).Delete
        Application.DisplayAlerts = True
        On Error Resume Next
        Sheets("TK_Register").ShowAllData
        On Error GoTo 0


    Sheets("AI_Register").Select
      Range("A1").Select

       Dim lrow1 As Long
       For lrow1 = Worksheets("AI_Register").Cells(Rows.Count, "M").End(xlUp).Row To 2 Step -1
           If Cells(lrow1, "M") = Cells(lrow1, "M").Offset(-1, 0) Then
              Cells(lrow1, "M").Offset(-1, 0).EntireRow.Delete
           End If

        Next lrow1

       ActiveWorkbook.RefreshAll
        Sheets("EditEx").Select
        ActiveWindow.SmallScroll Down:=-120
        Range("B13").Select

    MsgBox ("Record Updates have been Saved")

    End Sub

Solution

  • Below is a sample code using .RemoveDupliates which remove duplicates from column 1 of the range given taking in consideration that the column has header.

    Option Explicit
    
    Sub test()
    
        Dim LastroW As Long
    
        With ThisWorkbook.Worksheets("Sheet1")
    
            LastroW = .Cells(.Rows.Count, "A").End(xlUp).Row
    
            .Range("A1:A" & LastroW).RemoveDuplicates Columns:=1, Header:=xlYes
    
        End With
    
    End Sub