PDA

View Full Version : Changing named range in loop



craigers77
08-20-2008, 02:05 PM
I have a simple loop to delete duplicate rows if a couple values in the row are the same. It works great but I have 6 sets of "options" to go through. I am using named ranges "Options2", "Options3", etc. Is there a way to loop throught the routine and change the name each time (like make the last # of the name a wildcard) or will I just have to continue showing the code 6 times (works fine but clutters up the sub). Thanks.

Here is a section of the code..
-----------------------------------------
Options2.Cells(1, 1).Select
X = ActiveCell.Row
Y = X + 1
Do While Cells(X, 11).Value <> ""
Do While Cells(Y, 11).Value <> ""
If (Cells(X, 7).Value = Cells(Y, 7).Value) And (Cells(X, 8).Value = Cells(Y, 8).Value) Then
Cells(Y, 8).EntireRow.Delete
Else
Y = Y + 1
End If
Loop
X = X + 1
Y = X + 1
Loop
Options3.Cells(1, 1).Select
X = ActiveCell.Row
Y = X + 1
Do While Cells(X, 11).Value <> ""
Do While Cells(Y, 11).Value <> ""
If (Cells(X, 7).Value = Cells(Y, 7).Value) And (Cells(X, 8).Value = Cells(Y, 8).Value) Then
Cells(Y, 8).EntireRow.Delete
Else
Y = Y + 1
End If
Loop
X = X + 1
Y = X + 1
Loop

Bob Phillips
08-20-2008, 02:35 PM
Sub DeleteAll()

Call DeleteData(Options2)

Call DeleteData(Options3)
End Sub

Sub DeleteData(rng As Range)
Dim i As Long
Dim j As Long

With rng

i = 1
Do While .Cells(i, 11).Value <> ""

j = i + 1
Do While .Cells(i + 1, 11).Value <> ""
If .Cells(i, 7).Value = .Cells(j, 7).Value And _
.Cells(i, 8).Value = .Cells(j, 8).Value Then
.Rows(j).Delete
Else
j = j + 1
End If
Loop

i = i + 1
Loop
End With
End Sub

craigers77
08-22-2008, 10:35 AM
Sub DeleteData(rng As Range)
Dim i As Long
Dim j As Long

With rng

i = 1
j = i + 1
Do While .Cells(i, 11).Value <> ""
Do While .Cells(j, 11).Value <> ""
If .Cells(i + 1, 2).Value = .Cells(j, 2).Value_
And .Cells(i, 3).Value = .Cells(j, 3).Value Then
.Rows(j).Delete
Else
j = j + 1
End If
Loop

i = i + 1
j = i + 1
Loop
End With
End Sub

craigers77
08-22-2008, 10:41 AM
I like the layout, but I had to make a couple minor mods to get it to do what I needed. Evertything worked when the rows were the same, but it was hanging up on the first row if the second line was different. Thanks for your help.


Sub DeleteData(rng As Range)
Dim i As Long
Dim j As Long

With rng

i = 1
j = i + 1
Do While .Cells(i, 11).Value <> ""
Do While .Cells(j, 11).Value <> ""
If .Cells(i + 1, 2).Value = .Cells(j, 2).Value_
And .Cells(i, 3).Value = .Cells(j, 3).Value Then
.Rows(j).Delete
Else
j = j + 1
End If
Loop

i = i + 1
j = i + 1
Loop
End With
End Sub