how can I use VBA to loop through list?

[jmckeone]

I want to be able to examine a range of cells for a value in another range of items so that rows meeting that criteria will be deleted. Reason I showed both text string and numbers is that I'd like to know how to use both approaches.

Book6
	A	B	C	D
1	Value	Color
2	2500	white
3	1236	red
4	4897	pink
5	5712	black
6	9425	blue
7	1425	brown
8	9974	purple
9	2500	yellow
10	7419	tan
11
12
13	RemoveValue	RemoveColor
14	2500	green
15	1425	blue
16	9974	yellow
Sheet1

 

[jmckeone]

Can't figure how to get the HTML and my explanation of it in the same post so this reply indicates what I'm trying to achieve.

I want to be able to look at a range of cells, for example A2:A10, and check them against A14:A16. When there is a match the row will be deleted.

Also included in Column B the option of doing the same thing based on a text string.

Appreciate any assistance.

 

[Rob Lanctot]

How about this? It can be changed to suit the number of rows and columns you're actually using. If there are many columns, I'd use a for:next loop for them as well, instead of using a bunch of different 'if:then's. If you need help with that let me know.
Rob

Dim rw As Integer
Sub test()

For rw = 1 To 10
    If Cells(rw, 1) = Cells(14, 1) Or Cells(rw, 1) = Cells(15, 1) Or Cells(rw, 1) = Cells(16, 1) Then
    Cells(rw, 1) = ""
    End If
    If Cells(rw, 2) = Cells(14, 2) Or Cells(rw, 2) = Cells(15, 2) Or Cells(rw, 2) = Cells(16, 2) Then
    Cells(rw, 2) = ""
    Else
    End If
    Next rw
End Sub

 

[Rob Lanctot]

Whoops, I noticed you wanted to delete the row (I think you mean cell, as if you delete the entire row, you lose data in adjacent cells in that row). To do that, you'd replace the Cells(rw, x)="" statement with this:

Cells(7, 1).Select
Selection.Delete Shift:=xlUp

Cheers[/code]

 

[Rob Lanctot]

ADVERTISEMENT

*sigh*

Too quick on the 'send' there - sorry.

That should be Cells (rw, 1).Select (or rw, 2)

 

[jmckeone]

The actual cases for me to use this can involve lists up to 100+ items in length so the Or approach isn't practical. Any other ideas?

 

[Tom Urtis]

ADVERTISEMENT

Number values are also strings in your case so the number vs text concern is not an issue. It might be an issue if the numbers were decimalzed integers or dates but whole numbers as you depict them in your screen shot are no problem to deal with.

Your request for a macro to do what you want to do here is made more interesting by the design layout of the sheet, whereby you have the larger duplicate-containing range sitting above the smaller criteria range. That means, an advisable approach would likely not include stepping through the rows one by one and deleting them as the criteria is met during the course of macro execution, because then the criteria range itself will be altered and needing to be redefined at each row deletion, not very efficient. I suppose the criteria could be placed in a bound array beforehand to address that, but in case you have a hundred criteria, arrays might not be the best way to go either.

Assuming you have no more than 8192 contiguous blocks of unique strings (a safe assumption by a longshot because you said you only have 100 rows to consider), this macro is the way I might approach the problem. It will work for any column, for text or whole numbers. You can easily see in the code where to modify the respective ranges of interest, for the variables named DuplicateValueRange and RemoveValueRange.



Sub Test1()
Application.ScreenUpdating = 0
Dim cell As Range, DuplicateValueRange As Range, RemoveValueRange As Range, LC%
Set DuplicateValueRange = Range("A2:A10")
Set RemoveValueRange = Range("A14:A16")
LC = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For Each cell In DuplicateValueRange.SpecialCells(2)
If WorksheetFunction.CountIf(RemoveValueRange, cell.Value) = 0 Then Cells(cell.Row, LC + 1).Value = "x"
Next cell
On Error Resume Next
With DuplicateValueRange
.Offset(0, LC - .Column + 1).Resize(.Rows.Count, 1).SpecialCells(4).EntireRow.Delete
End With
Err.Clear
Columns(LC + 1).Clear
Set DuplicateValueRange = Nothing
Set RemoveValueRange = Nothing
Application.ScreenUpdating = 1
End Sub

 

[jmckeone]

will give that a try

Normally the range I check against actually resides on a different sheet. I'd only put them on the same page for the sake of simplicity in presenting what I was trying to accomplish.

I'll give that a shot and get back to you on the results.
_____________

update: ran the code and it works fine ... will take a shot at adapting it to the situation at work when I get back to the office on Monday

 

[Tom Urtis]

Re: will give that a try

update: ran the code and it works fine ... will take a shot at adapting it to the situation at work when I get back to the office on Monday

This is how it can be modified where different sheets are involved; modify further for actual sheet names and range addresses.



Sub Test2()
Application.ScreenUpdating = 0
Dim cell As Range, DuplicateValueRange As Range, RemoveValueRange As Range, LC%
With Worksheets("Sheet1")
Set DuplicateValueRange = .Range("B1:B10")
Set RemoveValueRange = Worksheets("Sheet2").Range("J8:J9")
LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For Each cell In DuplicateValueRange.SpecialCells(2)
If WorksheetFunction.CountIf(RemoveValueRange, cell.Value) = 0 Then .Cells(cell.Row, LC + 1).Value = "x"
Next cell
On Error Resume Next
With DuplicateValueRange
.Offset(0, LC - .Column + 1).Resize(.Rows.Count, 1).SpecialCells(4).EntireRow.Delete
End With
Err.Clear
.Columns(LC + 1).Clear
End With
Set DuplicateValueRange = Nothing
Set RemoveValueRange = Nothing
Application.ScreenUpdating = 1
End Sub