Macro to clear content from cells based on content in another sheet

[Slimat]

Hi Guys

I think I am making this too complicated - but and struggling to find an answer.

I have two sheets -

sheet1 has two columns with text in both.

On sheet2 I have several columns which "may" contain an exact match to the contents of the cells in either column from sheet1. I need a way to clear the contents from any cells on sheet2 that exactly match the contents from the cells on sheet1.

It must be an "exact" lookup as there are cells in sheet2 which contain the contents in sheet1 but with extra information too.

Can anyone help? Thanks in advance

 

[Legacy 143009]

Hi,

Could you please specify two columns of Sheet1?

Also it will be beneficial if can you provide the "several columns" of Sheet2.

 

[Slimat]

As an example... here is what sheet1 and sheet2 may look like... I need a macro which will delete the highlighted cell from sheet2 as they are present in sheet1

 

[Legacy 143009]

Sheet1:

Sheet2:

Code:

Sub test()
  Dim sheet2ColumnA As Variant, sheet2ColumnC As Variant, sheet1Array As Variant
  Dim sheet1Dictionary As Object, i As Long
  
  Set sheet1Dictionary = CreateObject("Scripting.Dictionary")
  
  sheet1Array = Worksheets("Sheet1").UsedRange
  
  For Each elemnt In sheet1Array
    If Not sheet1Dictionary.Exists(elemnt) Then
      sheet1Dictionary.Add elemnt, 1
    End If
  Next
  
  With Worksheets("Sheet2")
  sheet2ColumnA = Intersect(.UsedRange, .Columns("A"))
  sheet2ColumnC = Intersect(.UsedRange, .Columns("C"))
  
  
  For i = 1 To UBound(sheet2ColumnA, 1)
    If sheet1Dictionary.Exists(sheet2ColumnA(i, 1)) Then
      sheet2ColumnA(i, 1) = ""
    End If
  Next
    For i = 1 To UBound(sheet2ColumnC, 1)
    If sheet1Dictionary.Exists(sheet2ColumnC(i, 1)) Then
      sheet2ColumnC(i, 1) = ""
    End If
  Next
  .Range("A1").Resize(UBound(sheet2ColumnA, 1), 1).Value = sheet2ColumnA
  .Range("C1").Resize(UBound(sheet2ColumnC, 1), 1).Value = sheet2ColumnC
  End With
End Sub

Sheet2 Result:

 

[Legacy 143009]

For your scenario;

Sub test()
  Dim sheet2ColumnAE As Variant, sheet1Array As Variant
  Dim sheet1Dictionary As Object, i As Long, j As Long
 
  Set sheet1Dictionary = CreateObject("Scripting.Dictionary")
 
  sheet1Array = Worksheets("Sheet1").UsedRange

  For Each elemnt In sheet1Array
    If Not sheet1Dictionary.Exists(elemnt) Then
      sheet1Dictionary.Add elemnt, 1
    End If
  Next
 
  With Worksheets("Sheet2")
  sheet2ColumnAE = Intersect(.UsedRange, .Range("A:E"))
 
  For i = 1 To UBound(sheet2ColumnAE, 1)
    For j = 1 To UBound(sheet2ColumnAE, 2)
      If sheet1Dictionary.Exists(sheet2ColumnAE(i, j)) Then
        sheet2ColumnAE(i, j) = ""
      End If
    Next
  Next
  .Range("A1").Resize(UBound(sheet2ColumnAE, 1), UBound(sheet2ColumnAE, 2)).Value = sheet2ColumnAE
  End With
End Sub

 

[Slimat]

Thanks @Flashbond

I imported your macro into my sheet and it did work, but it only cleared the duplicate cells in column C in sheet2 - it didnt remove the duplicates from columns B, D or E. Here is what I was left with;

 

[Legacy 143009]

Can you try my last code?

 

[Slimat]

Thanks @Flashbond that works perfectly in my test sheet - my actual sheet has a varying number of columns to search - depending on what they send. Sometimes up to about 30 - always start in column C and then can go up as high as AF... where do I change the number of columns to search?

 

[Legacy 143009]

Then it will be something like:

Sub test()
  Dim sheet2Array As Variant, sheet1Array As Variant
  Dim sheet1Dictionary As Object, i As Long, j As Long
  Set sheet1Dictionary = CreateObject("Scripting.Dictionary")
 
  sheet1Array = Worksheets("Sheet1").UsedRange
  For Each elemnt In sheet1Array
    If Not sheet1Dictionary.Exists(elemnt) Then
      sheet1Dictionary.Add elemnt, 1
    End If
  Next
 
  With Worksheets("Sheet2")
  sheet2Array = .UsedRange
  For i = 1 To UBound(sheet2Array, 1)
    For j = 3 To UBound(sheet2Array, 2)
      If sheet1Dictionary.Exists(sheet2Array(i, j)) Then
        sheet2Array(i, j) = ""
      End If
    Next
  Next
  .Range("A1").Resize(UBound(sheet2Array, 1), UBound(sheet2Array, 2)).Value = sheet2Array
  End With
End Sub

Note: This code work only if Sheet2 column A and B has always a value.

 

[Slimat]

Thats seems perfect - thanks for the amazing help @Flashbond - as soon as I have tested it on some live data and confirmed the results I will mark as solved. Any problems I'll let you know.

Many thanks