I have the following code and am struggling to get it to work.
Sub FilterAndRemove()
Dim varDelItem As Variant
Dim lngRowStart As Long, _
lngRowLast As Long, _
lngRowActive As Long
Dim strMyCol As String
Dim rngDelRange As Range
varDelItem = Application.Transpose(Worksheets("ELEMENTS").Range("AA2:AA32"))
lngRowStart = 2
strMyCol = "A"
lngRowLast = Cells(Rows.Count, strMyCol).End(xlUp).Row
Application.ScreenUpdating = False
For lngRowActive = lngRowStart To lngRowLast
If Cells(lngRowActive, strMyCol) <> varDelItem Then
If rngDelRange Is Nothing Then
Set rngDelRange = Cells(lngRowActive, strMyCol)
Else
Set rngDelRange = Union(rngDelRange, Cells(lngRowActive, strMyCol))
End If
End If
Next lngRowActive
If Not rngDelRange Is Nothing Then
rngDelRange.EntireRow.Delete xlShiftUp
End If
Application.ScreenUpdating = True
End Sub
What I am trying to achieve: I have a list of values which will be the conditions. After pasting data onto active sheet and activating the macro, the filter function should find rows not containing the data from the conditions list and remove them.
I can get it to work by specifying only one condition, i.e. Range("AA2"), but I want it to check against the whole range/array. What is wrong with my code? I am getting Type Mistmatch error.
Thanks in advance.
Pls. try this code
Sub comp()
Dim varDelItem As Variant
Dim lngRowStart As Long, _
lngRowLast As Long, _
lngRowActive As Long
Dim strMyCol As String
Dim rngDelRange As Range
varDelItem = Application.Transpose(Worksheets("ELEMENTS").Range("AA2:AA32"))
lngRowStart = 2
strMyCol = "A"
lngRowLast = Cells(rows.Count, strMyCol).End(xlUp).Row
Application.ScreenUpdating = False
For lngRowActive = lngRowStart To lngRowLast
ident = False 'added
For Each cell In varDelItem 'added
If Cells(lngRowActive, strMyCol) = cell Then ident = True: Exit For 'added
Next cell 'added
If Not ident Then 'changed
If rngDelRange Is Nothing Then
Set rngDelRange = Cells(lngRowActive, strMyCol)
Else
Set rngDelRange = Union(rngDelRange, Cells(lngRowActive, strMyCol))
End If
End If
Next lngRowActive
If Not rngDelRange Is Nothing Then
rngDelRange.EntireRow.Delete xlShiftUp
End If
Application.ScreenUpdating = True
End Sub
The ident
variable is True if a match is found in the conditions range. Then not execute the adding to the deletion range.