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 :dunno

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 :yes