How to delete duplicates with two columns in a Excel macro using VBA?-CodePudding

I am trying to create A VBA macro where the user is asked from a input box to select a column for range like "A:A". They are then asked for a second column range, like "C:C" for example.

Once the two ranges are selected I want to have excel compare the two column ranges for duplicates and delete them from the first one.

For example if the user selected column range1 and column range2. And both have cells with the number 5 and 7, I want column range1 to delete all cells that are 5 and 7.

CodePudding user response：

I wrote some VBA code that would perform this operation based on how I understand what you are doing. However, I went with the assumption that the amount of data was relatively small and the need for efficiency wasn't great. Also, didn't worry about any error handling etc.

Modifications would be required to bring it up to scratch to perform more robustly.

Option Explicit

Sub DeleteDupValuesInFirstSelectedColumn() 'Routine to ask the user to select two ranges and then ' deletes the values in the column of the first that are duplicated ' in the 2nd range

Dim CWS As Worksheet
Dim SelRng As Range, Col1 As Range, Col2 As Range
Dim Cell1 As Range, Cell2 As Range

Set CWS = ActiveSheet

'Ask the user to select a range
Set SelRng = Application.InputBox( _
  Title:="Range 1 Selection", _
  Prompt:="Select the first column", _
  Type:=8)

'Limit the selection to the first column in the used range
Set Col1 = Intersect(CWS.UsedRange, SelRng.Columns(1).EntireColumn)

'Ask the user to select a second range
Set SelRng = Application.InputBox( _
  Title:="Range 2 Selection", _
  Prompt:="Select the second column", _
  Type:=8)

'Limit the selection again
Set Col2 = Intersect(CWS.UsedRange, SelRng.Columns(1).EntireColumn)

'Super inefficient. Relying on insignificant amounts of values
'Don't use loop within a loop for anything important
For Each Cell2 In Col2
    For Each Cell1 In Col1
        If Cell1.Value = Cell2.Value Then
            'If the correct cells are being filled, uncomment the line to delete
            Cell1.Interior.ColorIndex = 3
            'Cell1.Delete Shift:=xlUp
        End If
    Next Cell1
Next Cell2

End Sub