none
Excel 2010 : Delete rows in table with vba

    Question

  • hello,
    I have a 2 tables on 2 sheet with data coming from an SQL query, sheet1 = Orders ; sheet2 = Invoices
    I need to delete rows on sheet1 that have same data on sheet2.
    here an example :
    Sheet1
    PosNb|invoiceNb|Name|CustCode|
    10|650001010|Test|15000
    20|650001010|Test|15000
    30|650001010|Test|15000
    10|650002020|Test2|16000
    20|650002020|Test2|16000
    ...
    Sheet2
    PosNb|invoiceNb|Name|CustCode|
    10|650001010|Test|15000
    30|650001010|Test|15000
    20|650002020|Test2|16000
    ...
    how can I say in vba : If (posNb IN Sheet1 = posNb IN Sheet2) && (invoiceNb IN sheet1 = invoiceNb IN sheet2) then remove ROW in Sheet1
    In this example, rows 1,3 & 6 have to be deleted.
    Thank you for you help.
    Monday, January 16, 2012 5:08 PM

Answers

  • Oops! Somehow I missed this thread. Anyways here is the code

    Option Explicit
    
    Const H1 As String = "OrderNb"
    Const H2 As String = "PosNb"
    
    Sub Sample()
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim DelRange As Range, aCell As Range
        Dim ws1lastRow As Long, ws2lastRow As Long
        Dim i As Long, j As Long
        Dim ws1H1 As Long, ws1H2 As Long, ws2H1 As Long, ws2H2 As Long
        
        On Error GoTo Whoa
        
        Application.ScreenUpdating = False
        
        Set ws1 = Sheets("Sheet1")
        Set ws2 = Sheets("Sheet2")
        
        Set aCell = ws1.Rows(1).Find(H1)
        If Not aCell Is Nothing Then ws1H1 = aCell.Column
        
        If ws1H1 = 0 Then GoTo LetsContinue
        
        Set aCell = ws1.Rows(1).Find(H2)
        If Not aCell Is Nothing Then ws1H2 = aCell.Column
        
        If ws1H2 = 0 Then GoTo LetsContinue
        
        Set aCell = ws2.Rows(1).Find(H1)
        If Not aCell Is Nothing Then ws2H1 = aCell.Column
        
        If ws2H1 = 0 Then GoTo LetsContinue
        
        Set aCell = ws2.Rows(1).Find(H2)
        If Not aCell Is Nothing Then ws2H2 = aCell.Column
        
        If ws2H2 = 0 Then GoTo LetsContinue
        
        ws1lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
        ws2lastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
        
        For i = 2 To ws1lastRow
            For j = 2 To ws2lastRow
                If ws1.Cells(i, ws1H1).Value = ws2.Cells(j, ws2H1).Value Then
                    If ws1.Cells(i, ws1H2).Value = Cells(j, ws2H2).Value Then
                        If DelRange Is Nothing Then
                            Set DelRange = ws1.Rows(i)
                        Else
                            Set DelRange = Union(DelRange, ws1.Rows(i))
                        End If
                    End If
                End If
            Next j
        Next i
        
        If Not DelRange Is Nothing Then DelRange.Delete
    
    LetsContinue:
        Application.ScreenUpdating = True
        Exit Sub
        
    Whoa:
        MsgBox Err.Description
        Resume LetsContinue
    End Sub
    



    Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.
    • Marked as answer by niarky Friday, January 20, 2012 9:31 PM
    Thursday, January 19, 2012 11:14 PM
    Moderator

All replies

  • Like This?


    Paste this code in a module.


    Option Explicit
    
    Sub Sample()
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim DelRange As Range
        Dim ws1lastRow As Long, ws2lastRow As Long
        Dim i As Long, j As Long
        On Error GoTo Whoa
        
        Application.ScreenUpdating = False
        
        Set ws1 = Sheets("Sheet1")
        Set ws2 = Sheets("Sheet2")
        
        ws1lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
        ws2lastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
        
        For i = 2 To ws1lastRow
            For j = 2 To ws2lastRow
                If ws1.Range("A" & i).Value = ws2.Range("A" & j).Value Then
                    If ws1.Range("B" & i).Value = ws2.Range("B" & j).Value Then
                        If DelRange Is Nothing Then
                            Set DelRange = ws1.Rows(i)
                        Else
                            Set DelRange = Union(DelRange, ws1.Rows(i))
                        End If
                    End If
                End If
            Next j
        Next i
        
        If Not DelRange Is Nothing Then DelRange.Delete
    
    LetsContinue:
        Application.ScreenUpdating = True
        Exit Sub
        
    Whoa:
        MsgBox Err.Description
        Resume LetsContinue
    End Sub
    


    Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.
    Monday, January 16, 2012 5:19 PM
    Moderator
  • Hi Siddharth,

    Thank you for your anwser. But it works only in a standard table and I have a dynamic one ( it's an SQL request).

    If I run it I have the following error : "the delete method of range class failed"

    Any idea ?

    Tuesday, January 17, 2012 10:02 PM
  • Can you show the exact code that you are using and a snapshot of the actual sheets :)

    Once I see those then I will amend the code for a dynamic table.


    Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.
    Tuesday, January 17, 2012 10:07 PM
    Moderator
  • Orders:

    Invoices is almost the same : Headers have same names but in other columns.

    I want to check "OrderNb" and "PosNb".

     

    Is it possible to select colum header rather than entire column  ?

    Here is the code :

    Sub Sample()
    
        Dim ws1 As Worksheet, ws2 As Worksheet
    
        Dim DelRange As Range
    
        Dim ws1lastRow As Long, ws2lastRow As Long
    
        Dim i As Long, j As Long
    
        On Error GoTo Whoa
    
    
        Application.ScreenUpdating = False
    
    
        Set ws1 = Sheets("Commandes") // Name of orders sheet
    
        Set ws2 = Sheets("FactureNew") // Name of invoices sheet
    
    
    
        ws1lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
    
        ws2lastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
    
    
        For i = 2 To ws1lastRow
    
            For j = 2 To ws2lastRow
    
                If ws1.Range("F" & i).Value = ws2.Range("I" & j).Value Then // I have change the column letter...
    
                    If ws1.Range("N" & i).Value = ws2.Range("P" & j).Value Then
    
                        If DelRange Is Nothing Then
    
                            Set DelRange = ws1.Rows(i)
    
                        Else
    
                            Set DelRange = Union(DelRange, ws1.Rows(i))
    
                        End If
    
                    End If
    
                End If
    
            Next j
    
        Next i
    
    
    
        If Not DelRange Is Nothing Then DelRange.Delete
    
    
    
    LetsContinue:
    
        Application.ScreenUpdating = True
    
        Exit Sub
    
    
    
    Whoa:
    
        MsgBox Err.Description
    
        Resume LetsContinue
    
    End Sub
    


     

     



    • Edited by niarky Tuesday, January 17, 2012 10:33 PM
    Tuesday, January 17, 2012 10:31 PM
  • Ok it is easy :)

    We will use .Find to find the location (Column Number) of the "OrderNb" and "PosNb" and simply replace them in the above code.

    It is already 4:15 Am here and I was off to bed. I will look at it later in the day when I get up :)


    Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.
    Tuesday, January 17, 2012 10:45 PM
    Moderator
  • Any update ?

    Thursday, January 19, 2012 10:59 PM
  • Oops! Somehow I missed this thread. Anyways here is the code

    Option Explicit
    
    Const H1 As String = "OrderNb"
    Const H2 As String = "PosNb"
    
    Sub Sample()
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim DelRange As Range, aCell As Range
        Dim ws1lastRow As Long, ws2lastRow As Long
        Dim i As Long, j As Long
        Dim ws1H1 As Long, ws1H2 As Long, ws2H1 As Long, ws2H2 As Long
        
        On Error GoTo Whoa
        
        Application.ScreenUpdating = False
        
        Set ws1 = Sheets("Sheet1")
        Set ws2 = Sheets("Sheet2")
        
        Set aCell = ws1.Rows(1).Find(H1)
        If Not aCell Is Nothing Then ws1H1 = aCell.Column
        
        If ws1H1 = 0 Then GoTo LetsContinue
        
        Set aCell = ws1.Rows(1).Find(H2)
        If Not aCell Is Nothing Then ws1H2 = aCell.Column
        
        If ws1H2 = 0 Then GoTo LetsContinue
        
        Set aCell = ws2.Rows(1).Find(H1)
        If Not aCell Is Nothing Then ws2H1 = aCell.Column
        
        If ws2H1 = 0 Then GoTo LetsContinue
        
        Set aCell = ws2.Rows(1).Find(H2)
        If Not aCell Is Nothing Then ws2H2 = aCell.Column
        
        If ws2H2 = 0 Then GoTo LetsContinue
        
        ws1lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
        ws2lastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
        
        For i = 2 To ws1lastRow
            For j = 2 To ws2lastRow
                If ws1.Cells(i, ws1H1).Value = ws2.Cells(j, ws2H1).Value Then
                    If ws1.Cells(i, ws1H2).Value = Cells(j, ws2H2).Value Then
                        If DelRange Is Nothing Then
                            Set DelRange = ws1.Rows(i)
                        Else
                            Set DelRange = Union(DelRange, ws1.Rows(i))
                        End If
                    End If
                End If
            Next j
        Next i
        
        If Not DelRange Is Nothing Then DelRange.Delete
    
    LetsContinue:
        Application.ScreenUpdating = True
        Exit Sub
        
    Whoa:
        MsgBox Err.Description
        Resume LetsContinue
    End Sub
    



    Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.
    • Marked as answer by niarky Friday, January 20, 2012 9:31 PM
    Thursday, January 19, 2012 11:14 PM
    Moderator
  • I have the same error 'the delete method of range class failed'

    Do I miss something on my vba config ?

    Friday, January 20, 2012 9:04 AM
  • Can you upload a sample workbook so that I can test it myself?

    You can upload it at wikisend.com and then share the link here.


    Sid (A good exercise for the Heart is to bend down and help another up) Please do not email me your questions. I do not answer questions by email unless I get paid for it :) If you want, create a thread in Excel forum and email me the link and I will help you if I can.
    Friday, January 20, 2012 12:16 PM
    Moderator
  • Sorry my fault... I have to focus invoices sheet to run the code properly

    Thank you for your support !

    Friday, January 20, 2012 9:30 PM