Consulting

Results 1 to 13 of 13

Thread: Delete row if cell entries in 4 columns match

  1. #1

    Delete row if cell entries in 4 columns match

    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:-(
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    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
    Attached Files Attached Files

  4. #4
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5
    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.

  6. #6
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    Quote Originally Posted by LutonBarry View Post
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  7. #7
    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?

  8. #8
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #9
    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.

  10. #10
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  11. #11
    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

  12. #12
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  13. #13
    p45cal, Marvellous, absolutely marvellous.

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

Posting Permissions

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