If you are interested about manual method instead of VBA/Macro check my previous post.
Clean / Filter Set of Data Using a Keyword(s) - Part 01
This Code has 5 steps which will describe here.
First Step
Declaration of variables and assigning variables
Dim a As Long, b As Long, c As Long, d As Long
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim dl As Worksheet, da As Worksheet, wo As Worksheet, wk As Worksheet
Dim st As Variant
Dim rn As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
Set dl = Sheets("Data List")
Set da = Sheets("Dashboard")
Set wo = Sheets("List Without Keywords")
Set wk = Sheets("List With Keywords")
There are 5 sheets in this workbook. I have assigned 4 of them to variables for easy use. Then turned off events and screen updating to speed up the macro,
Second Step
Clear available data from output sheets and find last rows of input sheet and Keyword list. (Keyword list is on the column A of the Dashboard Sheet.
a = dl.Cells(Rows.Count, "A").End(xlUp).Row
i = dl.Cells(1, Columns.Count).End(xlToLeft).Column
j = da.Cells(Rows.Count, "A").End(xlUp).Row
wo.Cells.Clear
wk.Cells.Clear
dl.Activate
dl.Range("A1", Cells(1, i)).Copy Destination:=wo.Range("A1")
dl.Range("A1", Cells(1, i)).Copy Destination:=wk.Range("A1")
b = 2
l = Range(da.Range("B2").Value & 1).Column
variable b is going to use as row number of first row which is blank in the sheet List With Keywords sheet. Initially it is 2
Step Three
Loop through every cell in keyword list, filter data set using the each keyword and copy data with keyword to the sheet List With Keywords. Finally visible cells in the Data List sheet colored using yellow.
For k = 2 To j
st = da.Cells(k, "A").Value
dl.Range("A1", Cells(a, i)).AutoFilter Field:=l, Criteria1:="=*" & st & "*", Operator:=xlAnd
Set rn = Nothing
On Error Resume Next
Set rn = dl.Range("A2", Cells(a, i)).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rn Is Nothing Then
rn.Copy Destination:=wk.Range("A" & b)
b = b + rn.Cells.Count / i
rn.Interior.Color = RGB(255, 255, 0)
End If
Next
During every iterate of the loop b recalculating to have last empty row number. Here we can't use rn.Rows.Count because rn is not a continuous range. Some rows are hidden according to the filter and therfore rn.Rows.Count give the count of first continuous rows which is not correct. To overcome this error this code calculate all cells in the range and divide it by number of columns. (Cells Count = Columns Count * Rows Count)
Step Four
Filter the Data List sheet to show all rows which are not having any color and copy those data to the sheet List Without Keywords. These are the subset of Data List sheet data which don't having any keyword.
dl.Range("A1", Cells(a, i)).AutoFilter Field:=l, Operator:=xlFilterNoFill
Set rn = Nothing
On Error Resume Next
Set rn = dl.Range("A2", Cells(a, i)).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rn Is Nothing Then
rn.Copy Destination:=wo.Range("A2")
End If
dl.AutoFilterMode = False
dl.Cells.Interior.Pattern = xlNone
After all filter in the sheet Data List is removed using AutoFilterMode=False and all colors add to the cells set to none.
Step Five
If one row in Data List sheet included more than one keyword, macro copied it more than one to the List With Keywords sheet. Step Five is to remove those duplicates. If there is more than one row to consider .RemoveDuplicates method need to have all column numbers as a array. First four lines of this part is to build that array.
ReDim st(0 To i - 1)
For a = 0 To UBound(st)
st(a) = a + 1
Next
wk.Activate
wk.Range("A2", Cells(a, i)).RemoveDuplicates Columns:=(st), Header:=xlNo
Step Six
Finally code will display the Dashboard sheet and enable Events and screen updates.
da.Activate
MsgBox "Filter Complete", vbInformation
Application.ScreenUpdating = True
Application.EnableEvents = True
During this part code notify the user that process is over. If you turned off events and screen updating during any macro, make sure to turned on within the macro, Otherwise they are turned of until you close all opened excel files and open excel.
You can download the sample excel sheet with the macro using below link
Clean Data List.xlsm
