View Single Post
  #3   Report Post  
Dave Peterson
 
Posts: n/a
Default

Does this mean that Aboyne should have two records deleted and one record kept?
(Keep the singleton blank.)

If yes, then after I ran this macro, I got this output:

Aalsmear HSTD
Aashiana HSTD
Abaden HSTD
Abbey Park HSTD
Abbotsford HSTD
Abbotsford HSTD
Abbotsford HSTD
Abbotsroyd Farm HSTD
Abbottsfort HSTD
Aberavon HSTD
Aberystwyth HSTD
Abington HSTD
Aboyne HSTD delete
Aboyne
Aboyne delete
Abran HSTD
Acacia Downs HSTD delete
Acacia Downs HSTD delete
Acacia Downs delete
Acacia Downs delete
Acacia Farm HSTD
Accolade Lodge HSTD
Achmore HSTD
Achray HSTD
Acland Downs HSTD
Acreage HSTD
Acton HSTD
Acton Downs HSTD
Acton Meadows HSTD
Ada HSTD delete
Ada delete
Adair
Adair
Adams Flat
Addavale HSTD

Then I could just apply Data|Filter|Autofilter and delete those cells (or just
sort by that column and delete it manually).

I use column C for my indicator. I just overwrite anything that's the

Option Explicit
Sub testme()

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim BlankCtr As Long
Dim HSTDCtr As Long
Dim TotalCtr As Long

Dim myRng As Range

Dim KeepDelete() As String
Dim iCtr As Long
Dim MatchCtr As Long

With Worksheets("sheet1")
.Range("c:c").ClearContents
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

Set myRng = .Range(.Cells(FirstRow, "A"), .Cells(LastRow, "A"))

With myRng.Resize(, 2)
.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Key2:=.Columns(2), Order2:=xlDescending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With

iRow = FirstRow
Do

TotalCtr = Application.CountIf(myRng, .Cells(iRow, "A").Value)

BlankCtr = Application.Evaluate("=Sumproduct(--(" _
& myRng.Address(external:=True) & "=" _
& .Cells(iRow, "A").Address & "),--(" _
& myRng.Offset(0, 1).Address(external:=True) _
& "=""""))")

HSTDCtr = TotalCtr - BlankCtr

ReDim KeepDelete(1 To TotalCtr, 1 To 1)

MatchCtr = Application.Min(BlankCtr, HSTDCtr)

For iCtr = 1 To MatchCtr
KeepDelete(iCtr, 1) = "delete"
Next iCtr
For iCtr = TotalCtr - MatchCtr + 1 To TotalCtr
KeepDelete(iCtr, 1) = "delete"
Next iCtr

.Cells(iRow, "C").Resize(TotalCtr, 1).Value _
= KeepDelete

iRow = iRow + TotalCtr

If iRow LastRow Then
Exit Do
End If

Loop

End With
End Sub




wrote:

Hi All

I have joined two sets of records into two columns. The first column
gives the name of the record and the second column will either be blank
or have the text "HSTD". I am trying to eliminate a number of these
records - hopefully about 5000 of them. The problem is that some of the
records that have a blank cell in the second column should really have
the "HSTD" text. The only way of working out which ones come under this
category is to find out whether the number of records for a given name
with "HSTD" text equal the number of records that with a corresponing
blank cell. An extract of the data is below for those who may be a
little confused.

Aalsmear HSTD
Aashiana HSTD
Abaden HSTD
Abbey Park HSTD
Abbotsford HSTD
Abbotsford HSTD
Abbotsford HSTD
Abbotsroyd Farm HSTD
Abbottsfort HSTD
Aberavon HSTD
Aberystwyth HSTD
Abington HSTD
Aboyne HSTD
Aboyne
Aboyne
Abran HSTD
Acacia Downs HSTD
Acacia Downs HSTD
Acacia Downs
Acacia Downs
Acacia Farm HSTD
Accolade Lodge HSTD
Achmore HSTD
Achray HSTD
Acland Downs HSTD
Acreage HSTD
Acton HSTD
Acton Downs HSTD
Acton Meadows HSTD
Ada HSTD
Ada
Adair
Adair
Adams Flat
Addavale HSTD

For the example above the name Acacia Downs would be eliminated as it
has two records that have "HSTD" and two equivalent records that have a
blank cell. However the records with Aboyne would not be culled as it
has only one record with "HSTD" and two records with blank cells.
Records like Adair would not be touched as there are no records with
"HSTD". Can you see where we're coming from? I will eventually
eliminate all records that have "HSTD" but am using them to thresh out
the other records. I have already eliminated about 3000 records which
had one record each with the formula (placed in column C) after
appropriate sorting - =IF(AND(B1="HSTD", B2="", B3<"", A1=A2),"A","").
Then I would delete records tagged with "A". Just can't seem to come up
with something for more than two records each without thinking that it
needs VB.

Any help would be appreciated.

Regards,
Mike


--

Dave Peterson