PDA

View Full Version : delete rows based on two columns



Bendo
12-18-2009, 01:06 AM
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
12-18-2009, 01:18 AM
Could you attach an example workbook? No sensitive/private info, but similar data and layout to the real one.

Bendo
12-18-2009, 03:25 AM
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
12-18-2009, 03:34 AM
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
12-18-2009, 04:12 AM
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
12-18-2009, 04:48 AM
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
12-18-2009, 05:11 AM
:SHOCKED: 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
12-20-2009, 04:15 PM
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
12-21-2009, 05:02 AM
Thank you Bendo; Merry Christmas and God's best for you as well,

Mark

X10A
12-21-2009, 11:12 PM
Merry Christmas! :)