CODEWITHSUNDEEP
excelvba
MisterA
MisterA

Reputation: 153

Remove duplicates and keep formatting in VBA

I have a code that removes duplicates from Sheet "ANAF ANGAJATORI", range "A2:F1000". Criteria for duplicates: column 1 (A) & column 3 (C). (it removes only A:F because on col. G I have data that has to remain not afffected).

The problems are:

  1. I want to keep the formatting after removal of duplicates.

  2. Also I do not want to specify a given range as A2:F1000 because the data entry is variable and once it could be A2 to F100 and other times A2 to F10000. It should be something like A2:F. I guess I should define a lastrow and a variable?

This is my code:

Sub Duplicates()
     '
     ' Duplicates Macro
    Sheets("ANAF ANGAJATORI").Select
    ActiveSheet.range("A2:F1000").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
End Sub

Upvotes: 1

Views: 4478

Answers (3)

MisterA
MisterA

Reputation: 153

SOLUTION:

It solves problem number 2 by finding the last row on column A and then defining range A2:F & lastrow (A2 starting point to range F till lastrow).

Regarding problem number 1 it doesn't actually keep the formatting but it copies it from a cell at your choice already formated as you wish and pastes it all over the specified column resulting in reformatting the whole sheet (including the blank not formatted spaces left by the removal of duplicates). It ends up with the same result : keeping the formatting.

In the following exemple A2000 was in the sheet formated as number without decimals and C2000 as text.

Dim Src As Worksheet

' sets range from 
     Set Src = ThisWorkbook.Sheets("ANAF ANGAJATORI")

  ' finds the last row with data in column A
    lastRow = Src.range("A" & Src.Rows.Count).End(xlUp).Row

  ' removes duplicates
     Sheets("ANAF ANGAJATORI").range("A2:F" & lastRow).RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes

  ' formats the cells again to previous state by copying formatting from a certain cell (in this exemple A20000 is my last cell in the sheet, it will never be filled with data inputed by user)
     Sheets("ANAF ANGAJATORI").range("A20000").Copy
     Sheets("ANAF ANGAJATORI").range("A3:B" & lastRow).PasteSpecial xlPasteFormats
     Sheets("ANAF ANGAJATORI").range("A20000").Copy
     Sheets("ANAF ANGAJATORI").range("E3:F" & lastRow).PasteSpecial xlPasteFormats
     Sheets("ANAF ANGAJATORI").range("C20000").Copy
     Sheets("ANAF ANGAJATORI").range("C3:D" & lastRow).PasteSpecial xlPasteFormats

Upvotes: 0

Oliver Humphreys
Oliver Humphreys

Reputation: 472

I think this solves Problem 1.

for it to work you need to add a template sheet called "ANAF ANGAJATORI Template" which contains the formatting you require

It basically copies the formatting from the template onto the datasheet after the remove duplicates has been run.

Sub duplicates()

    Sheets("ANAF ANGAJATORI").Select
    ActiveSheet.Range("A2:F1000").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes

    Sheets("ANAF ANGAJATORI Template").Columns("A:F").Copy
    Sheets("ANAF ANGAJATORI").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select

End Sub

Upvotes: 1

Svekke
Svekke

Reputation: 1530

For you 2nd problem, you can try to define a range.

Dim x as Range
Set x = Worksheets("ANAF ANGAJATORI").Cells
ActiveSheet.range(x).RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes

UPDATE: This works for me:

Dim row As Long
row = ActiveSheet.Range("F" & ActiveSheet.Rows.Count).End(xlUp).Row
ActiveSheet.Range("A2:F" & row).RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes

Upvotes: 1

Related Questions