how can I use VBA to loop through list?

jmckeone

Well-known Member
Joined
Jun 3, 2006
Messages
550
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
ABCD
1ValueColor
22500white
31236red
44897pink
55712black
69425blue
71425brown
89974purple
92500yellow
107419tan
11
12
13RemoveValueRemoveColor
142500green
151425blue
169974yellow
Sheet1
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

jmckeone

Well-known Member
Joined
Jun 3, 2006
Messages
550
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

New Member
Joined
Aug 3, 2005
Messages
24
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

Code:
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

New Member
Joined
Aug 3, 2005
Messages
24
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

New Member
Joined
Aug 3, 2005
Messages
24

ADVERTISEMENT

*sigh*

Too quick on the 'send' there - sorry.

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

jmckeone

Well-known Member
Joined
Jun 3, 2006
Messages
550
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

MrExcel MVP
Joined
Feb 10, 2002
Messages
11,255

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

Well-known Member
Joined
Jun 3, 2006
Messages
550
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

MrExcel MVP
Joined
Feb 10, 2002
Messages
11,255
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
 

Forum statistics

Threads
1,136,926
Messages
5,678,605
Members
419,775
Latest member
joh93

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top