XL2000: How to Copy One of Each Record Type to Another Worksheet

   A1:  Part no.    B1:  Description     C1:  On Hand       D1:  Store
   A2:  10AB        B2:  Nuts            C2:  1             D2:  1
   A3:  11AB        B3:  Bolts           C3:  2             D3:  2
   A4:  10AB        B4:  Nuts            C4:  3             D4:  3
   A5:  12AB        B5:  Nuts            C5:  4             D5:  4
   A6:  11AB        B6:  Bolts           C6:  5             D6:  5
					

   A1:  Part no.    B1:  Description     C1:  On Hand       D1:  Store
					

   Sub CopyNoDupes()

       ' Selects sheet1.
       Worksheets("sheet1").select
       ' Selects cell A2.
       Range("a2").Select
       ' Turns off screen updating, which helps macro run faster.
       Application.ScreenUpdating = False

       ' Will run the below code until the active cell is blank.
       Do While ActiveCell.Value <> ""
           ' Flag is used to determine whether the record should be pasted
           ' to Sheet2.
           flag = True
           ' The variable value1 is assigned the value in the currently
           ' selected cell, initially cell A2.
           valuea = ActiveCell.Value
           ' Valueb is assigned the value in the cell one column to the
           ' right of the activecell, initially cell B2.
           valueb = ActiveCell.Offset(0, 1).Value

           ' Beginaddrs is assigned the address of the activecell.
           beginaddrs = ActiveCell.Address
           ' Endaddrs is assigned the address of the last contiguous cell
           ' of data on the active row.
           endaddrs = ActiveCell.End(xlToRight).Address

           ' Copies the current row's record to Clipboard.
           Range(beginaddrs & ":" & endaddrs).Copy
           ' Selects sheet2.
           Sheets("sheet2").Select
           ' Selects cell A2.
           Range("a2").Select

           ' Determine if the record type has already been copied to
           ' Sheet2.
           Do While ActiveCell.Value <> ""

               ' If valuea, which contains the value from sheet1, equals
               ' the active cell's value in sheet2, and valueb equals
               ' the value in the cell immediately to the right of the
               ' active cell, then do the lines before the Else.
               If valuea = ActiveCell.Value And valueb = _
                   ActiveCell.Offset(0, 1).Value Then

                   ' Flag used in an If statement below. False indicates do
                   ' not paste record.
                   flag = False

                   ' Rowcount is assigned the current number of contiguous
                   ' rows of records.
                   rowcount = Range("a1").CurrentRegion.Rows.Count

                   ' Selects a blank row to exit out of Do While.
                   Range("a" & rowcount).Offset(1, 0).Select

               Else

                   ' Otherwise, select next record on Sheet2.
                   ActiveCell.Offset(1, 0).Select

               End If

           ' Check next record for a duplicate.
           Loop

           ' If flag was not set to False in the previous Do While Loop,
           ' for example, record type not in sheet2, then do the lines
           ' before the End If.
           If flag Then

               ' Rowcount is assigned the current number of contiguous rows
               ' of records.
               rowcount = Range("a1").CurrentRegion.Rows.Count

               ' Pastes the new record type after the last record.
               Range("a" & rowcount).Offset(1, 0).PasteSpecial
           End If

           ' Selects sheet1.
           Sheets("sheet1").Select
           ' Selects the next record on Sheet1.
           Range(beginaddrs).Offset(1, 0).Select

       ' Returns back to first Do While to repeat the above process.
       Loop

       ' Turns ScreenUpdating back on.
       Application.ScreenUpdating = True

       ' Removes the marquee around last copied record.
       Application.CutCopyMode = False

   End Sub