PDA

View Full Version : [SOLVED:] Delete row if cell entries in 4 columns match



LutonBarry
08-21-2018, 08:55 AM
Folks Hope you can aid me. I have a spreadsheet that if cell entries on a row in columns A, D, G and J match I would like the row from Col A to L to be deleted when it is run. Can't seem to get beyond matching 2 cells:-(

p45cal
08-22-2018, 03:16 AM
I don't see any code which begins to try to do this, however this might:
Sub blah()
Application.EnableEvents = False
With Sheets("laptops").ListObjects(1)
ColmArray = Array(.ListColumns("Asset in").Index, .ListColumns("Asset out").Index, .ListColumns("Asset Warranty").Index, .ListColumns("Chargeable asset").Index)
For rw = .ListRows.Count To 1 Step -1
With .ListRows(rw)
FirstValue = .Range.Cells(ColmArray(0)).Value
If FirstValue = .Range.Cells(ColmArray(1)).Value And FirstValue = .Range.Cells(ColmArray(2)).Value And FirstValue = .Range.Cells(ColmArray(3)).Value Then .Delete
End With
Next rw
End With
Application.EnableEvents = True
End Sub

LutonBarry
08-22-2018, 05:44 AM
p45cal,

Thank you so muchfor that. I've now been asked if it can work on 2 added worksheet tabs. I adapted yourcode to try to work. But I get a subscript out od range error when the code reaches the line below.

With Sheets("Desktop").ListObjects(1)

What am I missing here can the code be adapted to work on the sheets in the workbook?

The full code is:

Sub Duplicates()

Laptops
Desktop
SFF

End Sub


Private Sub Laptops()
Application.EnableEvents = False
Sheets("laptops").Activate
With Sheets("laptops").ListObjects(1)
ColmArray = Array(.ListColumns("Asset in").Index, .ListColumns("Asset out").Index, .ListColumns("Asset Warranty").Index, .ListColumns("Chargeable asset").Index)
For rw = .ListRows.Count To 1 Step -1
With .ListRows(rw)
FirstValue = .Range.Cells(ColmArray(0)).Value
If FirstValue = .Range.Cells(ColmArray(1)).Value And FirstValue = .Range.Cells(ColmArray(2)).Value And FirstValue = .Range.Cells(ColmArray(3)).Value Then .Delete
End With
Next rw
End With
Application.EnableEvents = True
End Sub
Private Sub Desktop()
Application.EnableEvents = False
Sheets("Desktop").Activate
With Sheets("Desktop").ListObjects(1)
ColmArray = Array(.ListColumns("Asset in").Index, .ListColumns("Asset out").Index, .ListColumns("Asset Warranty").Index, .ListColumns("Chargeable asset").Index)
For rw = .ListRows.Count To 1 Step -1
With .ListRows(rw)
FirstValue = .Range.Cells(ColmArray(0)).Value
If FirstValue = .Range.Cells(ColmArray(1)).Value And FirstValue = .Range.Cells(ColmArray(2)).Value And FirstValue = .Range.Cells(ColmArray(3)).Value Then .Delete
End With
Next rw
End With
Application.EnableEvents = True
End Sub
Private Sub SFF()
Application.EnableEvents = False
Sheets("SFF").Activate
With Sheets("SFF").ListObjects(1)
ColmArray = Array(.ListColumns("Asset in").Index, .ListColumns("Asset out").Index, .ListColumns("Asset Warranty").Index, .ListColumns("Chargeable asset").Index)
For rw = .ListRows.Count To 1 Step -1
With .ListRows(rw)
FirstValue = .Range.Cells(ColmArray(0)).Value
If FirstValue = .Range.Cells(ColmArray(1)).Value And FirstValue = .Range.Cells(ColmArray(2)).Value And FirstValue = .Range.Cells(ColmArray(3)).Value Then .Delete
End With
Next rw
End With
Application.EnableEvents = True
End Sub

p45cal
08-22-2018, 08:35 AM
Those other two sheets don't have a listobject (aka Table). Make the range (columns A:L only) into a table on each of those 2 sheets.

LutonBarry
08-22-2018, 09:04 AM
p45cal,

Brilliant it does the job now. If one of the sheets was not a table instead of 'listobject' what would the syntax be?

Many thanks for this. If only I could buy you a pint.

p45cal
08-22-2018, 09:30 AM
If one of the sheets was not a table instead of 'listobject' what would the syntax be?Quite a bit more involved. Can't you stick to them being tables? It'll be more robust.

If you're always going to process those 3 sheets together, you don't need to make separate macros for them, you can process all three with:
Private Sub ThreeSheets()
Application.EnableEvents = False
For Each sht In Sheets(Array("Laptops", "Desktop", "SFF"))
'sht.Activate 'this line deactivated since it's not required.
With sht.ListObjects(1)
ColmArray = Array(.ListColumns("Asset in").Index, .ListColumns("Asset out").Index, .ListColumns("Asset Warranty").Index, .ListColumns("Chargeable asset").Index)
For rw = .ListRows.Count To 1 Step -1
With .ListRows(rw)
FirstValue = .Range.Cells(ColmArray(0)).Value
If FirstValue = .Range.Cells(ColmArray(1)).Value And FirstValue = .Range.Cells(ColmArray(2)).Value And FirstValue = .Range.Cells(ColmArray(3)).Value Then .Delete
End With
Next rw
End With
Next sht
Application.EnableEvents = True
End Sub
(untested)

BUT… I note you've called your sub Duplicates. You do realise that this routine does not compare any row with any other row?
It only looks at one row at a time, and if the values in columns A, D, G and J OF THAT ROW are the same then it'll delete that row. That is what you asked for.

LutonBarry
08-22-2018, 12:57 PM
Oh lord well spotted p45cal, Sorry but what I wanted it to do was where there were 4 matches in a row and if that matched a row earlier or up toward the top of the sheet, to delete that earlier row leaving the more recent entry. I'm sorry but can you help?

p45cal
08-22-2018, 02:47 PM
There are 4 columns of dates; which one should I use to decide 'earlier'?
Are we allowed to sort the table by date?
If so then the macro could be a one or two-liner.

LutonBarry
08-22-2018, 11:55 PM
p45cal,
The data is entered from the top to the bottom, so if line7's data is a match in the 4 columns any that match in lines 2 to 6, I want to be deleted.

p45cal
08-23-2018, 10:32 AM
I'm trying to code as simply as I can. I can code treating lines higher in the sheet as being 'earlier'. But I'm lazy and thinking sometimes hurts my brain. There's a method of removing duplicates in Excel which is built-in, is very fast and translates to one line of code. The trouble is it removes duplicates from the bottom up; in your case the wrong ones. However, if we sort the data so that earlier dates are at the bottom, then using the built-in remove duplicates will remove the ones you want to lose. Trouble is that after that your data is in the wrong order. Easy, sort again so that the earliest lines are at the top again.
The two sort routines could also be one line of code each.
Easy in theory.
The trouble is the resulting order may not be exactly the same as the original order, because there are some matching dates in many rows in several columns and some rows with no dates at all (these last have mostly BSW in columns ADG&J, maybe you put those in manually to show the macro worked).

If, in real world data, a particular column has a date in every row, and we can use that column (perhaps in conjunction with other columns with dates) to sort the table in an order you want to see, it makes coding your macro a 3 line affair, quick, robust, and easy for you to see what's going on too. It also means my brain won't hurt as much.

If you can't tell me the above is possible then I'll code leaving the rows on the sheet in their original order, it's just not so straightforward so will take me longer.

LutonBarry
08-23-2018, 11:18 AM
p45cal Thanks for your reply. I agree lets keep it simple. The first date column from the left can be used to sort the data and then resort in the oldest to youngest order.

There will be a duplication of dates but the columns on which we are using to identify the duplicates will not be duplicated entries on the same day.

Really owe you one for this thanks very much.

Regs, Barry

p45cal
08-23-2018, 12:43 PM
try:
Sub blah2()
Application.EnableEvents = False
For Each sht In Sheets(Array("Laptops", "Desktop", "SFF"))
With sht.ListObjects(1)
.Range.Sort key1:=.ListColumns("Date in").Range, order1:=xlDescending, Header:=xlYes
.Range.RemoveDuplicates Columns:=Array(1, 4, 7, 10), Header:=xlYes
.Range.Sort key1:=.ListColumns("Date in").Range, order1:=xlAscending, Header:=xlYes
End With
Next sht
Application.EnableEvents = True
End Sub

LutonBarry
08-23-2018, 01:32 PM
p45cal, Marvellous, absolutely marvellous.

Does the trick so thank you once again you are a saviour.