Excel 2003 - Writing a Macro - How Do I...?

[Alton]

I'm trying to write a macro that will loop down a column and find identical
numbers, then check the values in the offset cells 3 columns away, decide
which value should be kept, and then delete the rows containing the unneeded
values. In other words, if I have 4 rows with the following number in column
C:

8475727

And the value in column F for these four rows is a possibility of :

EARTH
AIR
FIRE
WATER
ICE
STEAM

I want the macro to keep the rown containing "EARTH" if it's available and
delete the other rows. However, if "EARTH" is NOT available, I want it to
pick "AIR" and delete the rest. If "AIR"'s not available, I want it to pick
"FIRE", and so on.

Any insight into how this could be accomplished would be sweet. I'm fairly
new at VBA Programming, and this one is beyond me.

Thanks!

 

[Barb Reinhardt]

Try this
Sub Delete()
Dim myRange As Range
Dim myArray As Variant
Dim myDeleteRange As Range
Dim r As Range
Dim a As Variant


Set myRange = Range("F3") '<~~~enter the first cell of the series here
lrow = Cells(Rows.Count, myRange.Column).End(xlUp).Row
Set myRange = myRange.Resize(lrow - myRange.Row + 1, 1)

myArray = Array("EARTH", "AIR", "FIRE", "WATER", "ICE", "STEAM")

For Each a In myArray
Debug.Print a
If WorksheetFunction.CountIf(myRange, a) > 0 Then
Set myDeleteRange = Nothing
For Each r In myRange
If r.Value <> a Then
If myDeleteRange Is Nothing Then
Set myDeleteRange = r
Else
Set myDeleteRange = Union(myDeleteRange, r)
End If
End If
Next r
Debug.Print myDeleteRange.Address
myDeleteRange.EntireRow.Delete
Exit For
End If
Next a

End Sub

 

[Barb Reinhardt]

Slight modification
Sub Delete()
Dim myRange As Range
Dim myArray As Variant
Dim myDeleteRange As Range
Dim r As Range
Dim a As Variant


Set myRange = Range("F3") '<~~~enter the first cell of the series here
lrow = Cells(Rows.Count, myRange.Column).End(xlUp).Row
Set myRange = myRange.Resize(lrow - myRange.Row + 1, 1)

myArray = Array("EARTH", "AIR", "FIRE", "WATER", "ICE", "STEAM")

For Each a In myArray
Debug.Print a
If WorksheetFunction.CountIf(myRange, a) > 0 Then
Set myDeleteRange = Nothing
For Each r In myRange
If r.Value <> a Then
If myDeleteRange Is Nothing Then
Set myDeleteRange = r
Else
Set myDeleteRange = Union(myDeleteRange, r)
End If
End If
Next r
If Not myDeleteRange Is Nothing Then
Debug.Print myDeleteRange.Address
myDeleteRange.EntireRow.Delete
End If
Exit For
End If
Next a

End Sub

 

[Alton]

Thanks, Barb...I tried your first post, but nothing happened, and I don't
know enough about arrays (actually, I don't know ANYTHING about arrays) to
troubleshoot. I'll try this one, and let you know what happens.

Alton