G
Guest
I am beginning to learn macros and went through the tutorial on-line about
how to do a Loop macro. I have successfully run the macro, however, I want
to limit it. Right now the macro looks at columns C, J, K, and L and if the
data matches, it deletes or highlights the duplicate entry. However, this
does not take into account blank rows. Right now I have data in the first 18
rows and when I run the macro, it highlights not only my duplicate test
record, but also from rows 19 - infinity (or what seems like infinity).
How do I tell the macro to only look for duplicates in rows with text data
and to ignore the blank rows with my formulas in them? Worksheet (2) that
I'm running the macro on is being fed the data from Worksheet (1) with the
use of formulas.
Please help,
Thanks so much,
Sharon
p.s. here's the code I got from the on-line tutorial that I'm using:
Sub MultipleEntryDeletion()
'Start at the currently selected cell
x = ActiveCell.Row
y = x + 1
'Outside loop
Do While Cells(x, 3).Value <> ""
'Inside loop
Do While Cells(y, 3).Value <> ""
'Test for duplication:
'If the values of the third column (C) and the fifth column (E)
match in two rows (this part of the code I edited)
'delete the second row of the pair, otherwise go to the next row
until the end
If (Cells(x, 3).Value = Cells(y, 3).Value) And (Cells(x,
10).Value = Cells(y, 10).Value) And (Cells(x, 11).Value = Cells(y, 11).Value)
And (Cells(x, 12).Value = Cells(y, 12).Value) And (Cells(x, 13).Value =
Cells(y, 13).Value) Then
'FOR DUPLICATE DELETION: Uncommment the following line by
removing the apostrophe
'Cells(y, 3).EntireRow.Delete
'Shade the entire row green if it's a duplicate
'FOR DUPLICATE DELETION: Make the following line a comment
by adding an apostrophe
Cells(y, 3).EntireRow.Interior.ColorIndex = 4
Else
'FOR DUPLICATE DELETION: Uncomment the following line by
removing the apostrophe
'y = y + 1
End If
'FOR DUPLICATE DELETION: Make the following line a comment by
adding an apostrophe
y = y + 1
Loop
'increase the value of x by 1 to move the loop starting point to the
next row
x = x + 1
'reset y so it starts at the next row
y = x + 1
Loop
End Sub
how to do a Loop macro. I have successfully run the macro, however, I want
to limit it. Right now the macro looks at columns C, J, K, and L and if the
data matches, it deletes or highlights the duplicate entry. However, this
does not take into account blank rows. Right now I have data in the first 18
rows and when I run the macro, it highlights not only my duplicate test
record, but also from rows 19 - infinity (or what seems like infinity).
How do I tell the macro to only look for duplicates in rows with text data
and to ignore the blank rows with my formulas in them? Worksheet (2) that
I'm running the macro on is being fed the data from Worksheet (1) with the
use of formulas.
Please help,
Thanks so much,
Sharon
p.s. here's the code I got from the on-line tutorial that I'm using:
Sub MultipleEntryDeletion()
'Start at the currently selected cell
x = ActiveCell.Row
y = x + 1
'Outside loop
Do While Cells(x, 3).Value <> ""
'Inside loop
Do While Cells(y, 3).Value <> ""
'Test for duplication:
'If the values of the third column (C) and the fifth column (E)
match in two rows (this part of the code I edited)
'delete the second row of the pair, otherwise go to the next row
until the end
If (Cells(x, 3).Value = Cells(y, 3).Value) And (Cells(x,
10).Value = Cells(y, 10).Value) And (Cells(x, 11).Value = Cells(y, 11).Value)
And (Cells(x, 12).Value = Cells(y, 12).Value) And (Cells(x, 13).Value =
Cells(y, 13).Value) Then
'FOR DUPLICATE DELETION: Uncommment the following line by
removing the apostrophe
'Cells(y, 3).EntireRow.Delete
'Shade the entire row green if it's a duplicate
'FOR DUPLICATE DELETION: Make the following line a comment
by adding an apostrophe
Cells(y, 3).EntireRow.Interior.ColorIndex = 4
Else
'FOR DUPLICATE DELETION: Uncomment the following line by
removing the apostrophe
'y = y + 1
End If
'FOR DUPLICATE DELETION: Make the following line a comment by
adding an apostrophe
y = y + 1
Loop
'increase the value of x by 1 to move the loop starting point to the
next row
x = x + 1
'reset y so it starts at the next row
y = x + 1
Loop
End Sub