I have an excel Sheet1 of a thousand of rows and 20 columns from A1 to T1. Each cell in that range has some data in it, usually one or two words. In Sheet2, A1 column I have a list of data of 1000 values.
I am working on VBA script to find words from Sheet2 list in Sheet1 and clear the values of the cells of the found ones.
I now have a VBA script that works only on A1 column of Sheet1 and it deletes the rows only. Here's the script:
Sub DeleteEmails()
Dim rList As Range
Dim rCrit As Range
With Worksheets("Sheet1")
.Range("A1").Insert shift:=xlDown: .Range("A1").Value = "Temp Header"
Set rList = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
End With
With Worksheets("Sheet2")
.Range("A1").Insert shift:=xlDown: .Range("A1").Value = "Temp Header"
Set rCrit = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
End With
rList.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
rList.Offset(1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
Worksheets("Sheet1").ShowAllData
rList(1).Delete shift:=xlUp: rCrit(1).Delete shift:=xlUp
Set rList = Nothing: Set rCrit = Nothing
End Sub
Could anyone help me? I need the values cleared, not rows deleted, and this should work on all columns of Sheet1, not just A1.
Here is another method using an array by minimizing the traffic between sheet (iteration via range/cells) and code. This code doesn't use any clear contents
. Simply take the whole range into an array, clean it up and input what you need :) with a click of a button.
Code:
Option Explicit
Sub matchAndClear()
Dim ws As Worksheet
Dim arrKeys As Variant, arrData As Variant
Dim i As Integer, j As Integer, k As Integer
'-- here we take keys column from Sheet 1 into a 1D array
arrKeys = WorksheetFunction.Transpose(Sheets(1).Range("A2:A11").Value)
'-- here we take to be cleaned-up-range from Sheet 2 into a 2D array
arrData = WorksheetFunction.Transpose(Sheets(2).Range("C2:D6").Value)
'-- here we iterate through each key in keys array searching it in
'-- to-be-cleaned-up array
For i = LBound(arrKeys) To UBound(arrKeys)
For j = LBound(arrData, 2) To UBound(arrData, 2)
'-- when there's a match we clear up that element
If UCase(Trim(arrData(1, j))) = UCase(Trim(arrKeys(i))) Then
arrData(1, j) = " "
End If
'-- when there's a match we clear up that element
If UCase(Trim(arrData(2, j))) = UCase(Trim(arrKeys(i))) Then
arrData(2, j) = " "
End If
Next j
Next i
'-- replace old data with new data in the sheet 2 :)
Sheets(2).Range("C2").Offset(0, 0).Resize(UBound(arrData, 2), _
UBound(arrData)) = Application.Transpose(arrData)
End Sub
Please not that you what you really need to set here are the ranges:
Output: (for displaying purpose I am using the same sheet, but you can change the sheet names as you desire.
Edit based on OP's request for running OP's file:
The reason that it didn't clean all your columns is that in the above sample is only cleaning two columns where as you have 16 columns. So you need to add another for
loop to iterate through it. Not much performance down, but a little ;) Following is a screenshot after running your the sheet you sent. There is nothing to change except that.
Code:
'-- here we iterate through each key in keys array searching it in
'-- to-be-cleaned-up array
For i = LBound(arrKeys) To UBound(arrKeys)
For j = LBound(arrData, 2) To UBound(arrData, 2)
For k = LBound(arrData) To UBound(arrData)
'-- when there's a match we clear up that element
If UCase(Trim(arrData(k, j))) = UCase(Trim(arrKeys(i))) Then
arrData(k, j) = " "
End If
Next k
Next j
Next i