Results 1 to 4 of 4
  1. #1
    3 Star Lounger
    Join Date
    Nov 2001
    Location
    Upstate, South Carolina, USA
    Posts
    253
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Row Elimination Macro (2000 SR-1)

    I have an excel document with numerous columns and 100s of rows. The objective of this macro is to eliminate all rows, except for one, that have the same values in two specific adjacent columns.

    Refer to attachment for the BEFORE and AFTER tables.

    Steps:
    1. <LI>Since we cannot be guaranteed that the rows with the same values in the determinant column (F) will be adjacent, first, the macro must perform a full-table numeric sort on that column.
      <LI>For all rows with the same value in column F, delete all rows, except the first row, that meet the condition

      <UL>Value_ColF_row(i) = Value_ColF_Row(ii)
      AND
      Value_ColG_row(i) = Value_ColG_Row(ii)
    [/list]Ignore the values in all other columns, but retain them <img src=/S/smile.gif border=0 alt=smile width=15 height=15>.
    Attached Files Attached Files
    Al
    "Do or do not do. There is no try." -- Yoda
    <img src=/S/flags/USA.gif border=0 alt=USA width=30 height=18>

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Row Elimination Macro (2000 SR-1)

    Have you tried using the advanced filter?

    You could add a new column that is Fi & Gi. Then use the adv filter to copy only "unique records" based on this column.
    Steve

  3. #3
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Row Elimination Macro (2000 SR-1)

    I think that the VBA routine below will do what you want:

    <pre>Public Sub DelDups()
    Dim lMaxRows As Long, I As Long, J As Long
    With Worksheets("Sheet1")
    lMaxRows = .Range("F65536").End(xlUp).Row
    .Range(Rows(1), Rows(lMaxRows)).Sort _
    Key1:=.Columns("F"), Order1:=xlAscending, _
    Key2:=.Columns("G"), Order1:=xlAscending
    For I = 0 To lMaxRows - 2
    For J = lMaxRows To I + 1 Step -1
    If (.Range("F1").Offset(I, 0).Value = .Range("F1").Offset(J, 0)) And _
    (.Range("G1").Offset(I, 0).Value = .Range("G1").Offset(J, 0)) Then
    .Range("A1").Offset(J, 0).EntireRow.Delete
    End If
    Next J
    Next I
    End With
    End Sub
    </pre>

    Legare Coleman

  4. #4
    3 Star Lounger
    Join Date
    Nov 2001
    Location
    Upstate, South Carolina, USA
    Posts
    253
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Row Elimination Macro (2000 SR-1)

    Thanks. I'll try both of them.
    Al
    "Do or do not do. There is no try." -- Yoda
    <img src=/S/flags/USA.gif border=0 alt=USA width=30 height=18>

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •