I have the following problem. I have a Column "Data" and a column "Criteria" and I want to replace the cells of "Data" with "#N/A" based on:
<tbody>
</tbody>
Before:
<tbody>
</tbody>
Before:
<tbody>
</tbody>
What I am trying to do: I transformed "Criteria" into an array arrCriteria = {AAA;BBB;CCC;...}. Then I go to the data column, loop through it and each cell. If the cell is empty, then I don't need to do anything. If I found a comma in a data cell, then I need to check whether that cell is a full subset of arrCriteria (e.g. "AAA, BBB" or "CCC, BBB"). Then I will need a statement if there is only one entry, e.g. only "AAA", "BBB", "CCC"...
Here is what I have so far:
- if cell of "Data" is a equal to one of the criteria, then replace
- if cell of "Data" is a subset of the criteria, then replace
- if cell of "Data" is not a complete subset of the criteria, e.g. "AAA, CCC" (i.e. CCC is not in "Criteria"), then do not replace
Criteria |
AAA |
BBB |
DDD |
... |
... |
<tbody>
</tbody>
Before:
Data |
AAA |
BBB, AAA |
CCC |
DDD, BBB |
AAA, CCC |
CCC |
<tbody>
</tbody>
Before:
Data |
#N/A |
#N/A |
CCC |
#N/A |
AAA, CCC |
CCC |
<tbody>
</tbody>
What I am trying to do: I transformed "Criteria" into an array arrCriteria = {AAA;BBB;CCC;...}. Then I go to the data column, loop through it and each cell. If the cell is empty, then I don't need to do anything. If I found a comma in a data cell, then I need to check whether that cell is a full subset of arrCriteria (e.g. "AAA, BBB" or "CCC, BBB"). Then I will need a statement if there is only one entry, e.g. only "AAA", "BBB", "CCC"...
Here is what I have so far:
Code:
Sub SubsetArray()
lastRow = Criteria.Cells(Rows.Count, "D").End(xlUp).Row
Dim txt As String
Dim FullName As Variant
Dim cell As Range
Dim j As Long
Dim k As Long
Dim l As Long
Dim data As Worksheet
Dim Criteria As Worksheet
Set data = ThisWorkbook.Sheets("PBEXP")
Set Criteria = ThisWorkbook.Sheets("Verticals")
arrCriteria = Join(Application.Transpose(Criteria.Range("D2:D" & lastRow).value), "#")
Deleteme = Split(arrCriteria, "#")
lastRow = data.Cells(Rows.Count, "B").End(xlUp).Row
On Error Resume Next
For Each cell In data.Range(data.Cells(2, 10), data.Cells(lastRow, 10))
txt = cell.value ' current cell content
' If cell is empty, then do nothing
If IsEmpty(txt) Then ' if cell is empty then skip
' If a comma is found, then check if subset is found
ElseIf InStr(1, txt, ", ") > 0 Then
FullName = Split(txt, ", ") ' split cell content into array txt
For j = LBound(FullName) To UBound(FullName)
For k = LBound(Deleteme) To UBound(Deleteme)
If FullName(j) <> Deleteme(k) Then
Else if FullName(j) = Deleteme(k) then
data.Columns("J").Replace txt, "#N/A", xlWhole, , False, False, False
End If
Next k
Next j
End If
Next cell
End Sub