Deleting duplicate values from two different columns

[pandaboy]

Hello. The code below deletes duplicate text from a single column, like so:

From:
A
A
A
B
B
B
C
C
C

To:
A
empty row
empty row
empty row - additional empty row
B
empty row
empty row
empty row - additional empty row
C
empty row
empty row
empty row - additional empty row

I want to do the same for another column, in my case Column C. So delete duplicate text from Column A and Column C.

The code works for my needs, but I have no ideea how to make it work for another column. The code is copy / paste, I am not a programmer, and my VBA knowledge is very limited, so I have no ideea what to do next.

Thanks.

Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
    If WorksheetFunction.CountIf(Columns("A"), Range("A" & i).Value) > 1 Then Range("A" & i).ClearContents
Next i
Dim sh As Worksheet
Dim LstRw As Long, x
Set sh = Sheets("Sheet1")
With sh
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
For x = LstRw To 2 Step -1
If .Cells(x, 1) Like "*[ab]*" Then
.Cells(x, 1).EntireRow.Resize(2).Insert
End If
Next x
End With

[georgiboy]

Hi pandaboy,

Welcome to the forum.

Where you are using 'insert' do you rely on this to insert rows for other columns or are you actually working with a single column of data each time you run it?

[pandaboy]

Hi pandaboy,

Welcome to the forum.

Where you are using 'insert' do you rely on this to insert rows for other columns or are you actually working with a single column of data each time you run it?

Hello. This script inserts a new Row for all the columns, and it uses data only from Column A.

So for example if the data from column A is

Row Data
1 text example
2 text example
3 text example
4 another example
5 another example
6 another example
7 yet another example
8 yet another example
9 yet another example

after running the script the data from column A will look like this

Row Data
1 text example
2
3
4 <- script inserts 1 empty row here for all the columns
5 another example
6
7
8 <- script inserts 1 empty row here for all the columns
9 yet another example
10
11
12 <- script inserts 1 empty row here for all the columns


But now I want for the script to remove the duplicates from Column A and Column C, and to insert only 1 Row like in the example above.

Since I copy pasted the code I have no ideea how it works (i am not a programmer), but it does the job for me. This code snipped is part of a larger Macro (a bad one, that is made with more copy pasted code), which copies some data from another document, shifts rows, add some text, removes formatting + other things.

[georgiboy]

Yesterday i created the below code but it only works on one column of data and does not use insert as it handles the data in an array, maybe give it a run and you will see what i mean about the single column. The code works by you selecting the range first and then running the macro.

Sub test()    
    Dim var As Variant, col As New Collection, x As Long
    Dim OutVar As Variant, c As Variant, y As Long, z As Long
    
    var = Selection.Value ' hold values of selected range in memory
    ' loop through array and remove duplicates by placing them in a collection
    For x = 1 To UBound(var)
        On Error Resume Next
            col.Add var(x, 1), CStr(var(x, 1))
        On Error GoTo 0
    Next x
    ReDim OutVar(col.Count * 4 - 1) ' resize the final array to hold values
    ' loop through collection and write to final array
    For Each c In col
        OutVar(y) = c ' actual non duplicated number
        For z = 1 To 3
            OutVar(y + z) = vbNullString ' writing the blanks - 1 to 3
        Next z
        y = y + 4 ' increment the loop position to include blanks
    Next c
    Selection.ClearContents ' clear the selected range
    ' put the final array onto the first cell of selection
    Selection(1).Resize(UBound(OutVar) + 1) = Application.Transpose(OutVar)
End Sub

[pandaboy]

Thanks for the code but unfortunately it doesn't work properly

1. After the duplicates are removed the data that is supposed to remain is shifted down by 3 cells
2. A new row is not added like in the example I provided

Another thing is that I need to manually select the Column, which will require to rework my entire macro - which took a lot of time to creates since I have no ideea what I am doing

My script does the following sequentially.
1. Gives me the option to open manually a document with Application.Workbooks.Open(Application.GetOpenFilename())
2. Shows me several input boxes where I insert the target column from the opened document, for example I input B - Set rSrc = wbkSrc.Worksheets(sourceSheet).Columns(myValue1)
3. Takes the input value and assigns it to a Sheet for another document to a hardcoded value: Set rDest = wbkDest.Worksheets("Sheet1").Range("A1")
4. Clear formats
5. Removes duplicates from column A + inserts 1 row (the code I provided above)
6. Shifts down some cells
7. Adds values to other cells
8. Deletes some unnecessary rows.

I just need the code I provided to remove the duplicates from another Column, but I don't know how to modify it.

Step 5 is the most important, as there is a lot of Rows in the document, over 1000.

[georgiboy]

I see, that was why i asked the below:

Where you are using 'insert' do you rely on this to insert rows for other columns or are you actually working with a single column of data each time you run it?

Might be better if you can provide a sample workbook to work with, that way we will e able to see other data on the worksheet and gain a better understanding of what you are trying to achieve.

If you open my attachment and click the button you may see what i mean - the code was built to work on the sample provided.

[pandaboy]

Thanks for your help. In the end I found a solution by duplicating the same code. It looks like below. It's ugly and slow but it works somehow lmao.

Maybe someone can refactor it.

Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row


For i = LR To 1 Step -1
    If WorksheetFunction.CountIf(Columns("A"), Range("A" & i).Value) > 1 Then Range("A" & i).ClearContents
Next i


    Dim sh As Worksheet
    Dim LstRw As Long, x


    Set sh = Sheets("Sheet1")


    With sh
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row


        For x = LstRw To 2 Step -1


            If .Cells(x, 1) Like "*[ab]*" Then
                .Cells(x, 1).EntireRow.Resize(2).Insert
            End If


        Next x
        
    End With
    
    Dim LRD As Long, q As Long
        
LRD = Range("C" & Rows.Count).End(xlUp).Row
        For q = LRD To 2 Step -1
    If WorksheetFunction.CountIf(Columns("C"), Range("C" & q).Value) > 1 Then Range("C" & q).ClearContents
Next q
    Dim sh2 As Worksheet
    Dim LstRw2 As Long, w
    Set sh2 = Sheets("Sheet1")
    With sh2
        LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
        For w = LstRw To 1 Step -2
            If .Cells(w, 1) Like "*[ab]*" Then
                Debug.Assert True
                '.Cells(w, 1).EntireRow.Resize(1).Insert
            End If
        Next w
    End With

[georgiboy]

Without a sample file we are guessing most of it, it's a bit like giving you an artist name and three colours and asking you to give me the name of the picture.

[pandaboy]

You are right. I uploaded a sample document. If you run the macro you will see how is supposed to look.

Thanks.

[georgiboy]

Thanks for the file, will columns A & C always have the duplicates on the same row as it is in the sample file?

[pandaboy]

Column A and C will have different duplicates on the same row. The data is not connected in any way. In this case was easier for me to populate column C by just copying the contents from column A.

The code is not directly used (invoked??) by any other part of my script so you can rewrite it as you please.

Thanks