delete rows based on two columns

[Bendo]

Hi all,
First post here and fairly new to VBA.
I've been learning Excel & VBA by recording macros, but i'm stumped at this problem. Surely someone has had it before but I can't seem to find code anywhere.

I have two sheets of data with 21 fields each.
First sheet is current data, second sheet is new data.
I need to compare both sheets based on two selected columns.
They are part number (Column A, this is the key) and the price (Column B, this changes). The rest of the row has other stuff but is not needed to compare.

So what I need is something that goes...
grab part number from first sheet column A and search second sheet column A for same part number. Then go to first sheet price (column B of the part number being searched on) and compare with second sheet price (column B matching part number).

If the same price on both sheets then delete from BOTH sheets the entire row that matches on product and price.

If second sheet new price different then leave the row on second sheet but delete from first sheet.

If on the first sheet the part exists but is not found on the second sheet then leave the part on the first sheet.

If new part on the second sheet then leave on the second sheet.


Anyone done this in the past? I've come across many code examples of compare/delete on matching rows but all based on one column - not two.
This is a bit beyond my skill level right now but any pointers helpful. I'm not even sure how to start!

Ben

[GTO]

Could you attach an example workbook? No sensitive/private info, but similar data and layout to the real one.

[Bendo]

Thanks for the reply. Sorry I should have thought of attaching an example.

Attached is an .xls with sheet1 with the old data and sheet2 with the new data. (xl2003)

There will be thousands of rows in the real sheets. Still it only needs processing on the two first columns.

I'm going to have to do this nearly every day.

Anyway thanks for any help you can give.

Bendo

[Bendo]

Thinking about the output on the second sheet I said earlier...

"If second sheet new price different then leave the row on second sheet but delete from first sheet."

But perhaps what I really need is that if just a price change on the item, then the whole row of the fist sheet needs to be kept and moved to the second sheet (or a third sheet if easier) with all the data and the updated price.

I'm thinking ahead that if there are products that are discontinued then they will be remaining on the first sheet. New products will show up on the second sheet.

Updated prices for existing product can also be on the second sheet or put on a third sheet with the first sheet row and the second sheet price. Anyway I may be able to do this later. I just don't know how to compare/delete on two variables.

Thanks.
Bendo

[X10A]

Hi Bendo,

Please see the attached file. I used formula instead of VBA (because I do not know how to do it in VBA!)

This solution is based on your first post. Can it be used?

[GTO]

Greetings All,

Not well tested, but maybe...

In a Standard Module:

Option Explicit
    
Sub exa()
Dim _
wksOld              As Worksheet, _
wksNew              As Worksheet, _
wksDiscontinued     As Worksheet, _
wksUpdated          As Worksheet, _
rngLRow             As Range, _
rngOldSheet         As Range, _
rngNewSheet         As Range, _
rngRecord           As Range, _
rCell               As Range
    
    With ThisWorkbook
        '// Change sheetnames to match actual                                           //
        Set wksOld = .Worksheets("Sheet1")
        Set wksNew = .Worksheets("Sheet2")
        
        '// Find last record in old sheet.                                              //
        Set rngLRow = wksOld.Range("A:A").Find(What:="*", _
                                               After:=wksOld.Cells(1, 1), _
                                               LookIn:=xlValues, _
                                               LookAt:=xlPart, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlPrevious)
        '// Bail if nothing found...                                                    //
        If rngLRow Is Nothing Then Exit Sub
        
        '// Set a reference to the range we need to look from.                          //
        Set rngOldSheet = Range(wksOld.Range("A2"), rngLRow)
        
        '// SAA//
        Set rngLRow = wksNew.Range("A:A").Find(What:="*", _
                                               After:=wksNew.Cells(1, 1), _
                                               LookIn:=xlValues, _
                                               LookAt:=xlPart, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlPrevious)
        
        If rngLRow Is Nothing Then Exit Sub
        
        Set rngNewSheet = Range(wksNew.Range("A2"), rngLRow)
        
        '// Set references to added sheets.                                             //
        Set wksDiscontinued = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count), _
                                              Type:=xlWorksheet)
        Set wksUpdated = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count), _
                                         Type:=xlWorksheet)
    End With
    
    wksDiscontinued.Name = "Discontinued"
    wksUpdated.Name = "Updated"
    
    '// Header labels for new sheets.                                                   //
    wksDiscontinued.Range("A1:U1").Value = wksOld.Range("A1:U1").Value
    wksUpdated.Range("A1:U1").Value = wksOld.Range("A1:U1").Value
    
    '// for each record in old sheet...                                                 //
    For Each rCell In rngOldSheet
        '// ...see if there's a matching record in new sheet; ...                       //
        Set rngRecord = rngNewSheet.Find(What:=rCell.Value, _
                                         After:=rngNewSheet(1, 1), _
                                         LookIn:=xlValues, _
                                         LookAt:=xlWhole, _
                                         SearchOrder:=xlByRows, _
                                         SearchDirection:=xlNext)
        '// ...then if not, add this record to discontinued sjeet.                      //
        If rngRecord Is Nothing Then
            wksDiscontinued.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 21).Value _
                = rCell.Resize(, 21).Value
        Else
            '// If there was a matching record, I think we can skip checking for a price//
            '// difference - maybe just take the latest price instead?                  //
            wksUpdated.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 21).Value _
                = rngRecord.Resize(, 21).Value
            '// Now, we'll delete the record from the newer sheet.  This way, any records//
            '// left on the new sheet, should be new - that is, they didn't exist on the//
            '// old sheet.                                                              //
            Application.DisplayAlerts = False
            rngRecord.EntireRow.Delete
            Application.DisplayAlerts = True
        End If
    Next
    
    
    Set rngLRow = wksNew.Range("A:A").Find(What:="*", _
                                           After:=wksNew.Cells(1, 1), _
                                           LookIn:=xlValues, _
                                           LookAt:=xlPart, _
                                           SearchOrder:=xlByRows, _
                                           SearchDirection:=xlPrevious)
    '// If we had records (new ones) left on the new sheet, add these to the updated    //
    '// sheet.                                                                          //
    If Not rngLRow Is Nothing Then
        Set rngNewSheet = Range(wksNew.Range("A2"), rngLRow).Resize(, 21)
        rngNewSheet.Copy Destination:=wksUpdated.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
    
    '// pretty up the added sheets...                                                   //
    wksDiscontinued.Columns.AutoFit
    wksUpdated.Columns.AutoFit
End Sub

Hope that helps,

Mark

[GTO]

Wellll...[BLEEP]!

I believe the code copied okay, try and ignore the spotty colorization...

I've been trying to write some code to mark-up keywords while keeping spacing, and appear to be not quite there yet...

[Bendo]

Hi GTO and X10A,

Thanks mates! Wow, two great solutions in next to no time. Both work very well. I'm now trying to understand how they both work and see if I can learn a bit more about doing what I'm trying to do.

If I don't manage to get back to you again before Christmas, then I hope you have a happy and holy Christmas!

What a fantastic forum!
Bendo.

[GTO]

Thank you Bendo; Merry Christmas and God's best for you as well,

Mark

[X10A]

Merry Christmas!