Results 1 to 6 of 6

Thread: Compare with loop and delete

  1. #1

    Compare with loop and delete



    Register for a FREE account, and/
    or Log in to avoid these ads!

    I need a macro that compares the datas in column A and B of the sheets 'Patches' and 'NA' and deletes the data in the 'Patch' sheet that matches with the ones in the 'NA' sheet.
    It should loop with data in the 'patches' sheet with the ones in the 'NA' sheet.
    There are multiple patches (column B) for the same server (Column A). so i want to check whether a server and its patches list in NA sheet matches if so it has to be deleted in the patches sheet.
    I have saved the result data which i want in the 'Result' for your reference.
    Thanks in Adavance!!
    Attached Files Attached Files

  2. #2
    Super Moderator Bob Phillips's Avatar
    Join Date
    Mar 2011
    Posts
    1,823
    Articles
    0
    Excel Version
    O365
    Code:
    Option Explicit
    
    Public Sub DeleteMatches()
    Const FORMULA_MATCH As String = _
        "=MATCH(1,(A<row>=NA!A1:A<lastrow>)*(B<row>=NA!B1:B<lastrow>),0)"
    Dim results As Worksheet
    Dim na As Worksheet
    Dim matchFormula As String
    Dim matchrow As Long
    Dim lastna As Long
    Dim lastrow As Long
    Dim i As Long
    
    
        Application.ScreenUpdating = False
        
        On Error Resume Next
        Set results = Worksheets("Result")
        On Error GoTo 0
        If Not results Is Nothing Then
        
            results.Cells.ClearContents
        Else
        
            Set results = Worksheets.Add(after:=Worksheets(Worksheets.Count))
            results.Name = "Result"
        End If
        
        Set na = Worksheets("NA")
        lastna = na.Range("A1").End(xlDown).Row
        matchFormula = Replace(FORMULA_MATCH, "<lastrow>", lastna)
        
        Worksheets("PATCHES").UsedRange.Copy results.Range("A1")
        results.Columns("A:B").AutoFit
        With results
        
            lastrow = .Range("A1").End(xlDown).Row
            For i = lastrow To 2 Step -1
            
                matchrow = 0
                On Error Resume Next
                matchrow = Application.Evaluate(Replace(matchFormula, "<row>", i))
                On Error GoTo 0
                If matchrow > 0 Then
                
                    If .Cells(i, "B").Value = na.Cells(matchrow, "B").Value Then
                
                        .Rows(i).Delete
                    End If
                End If
            Next i
        End With
         
        Application.ScreenUpdating = True
    End Sub

  3. #3

    Macro for Compare with loop and delete

    Quote Originally Posted by sarajun_88 View Post
    I need a macro that compares the datas in column A and B of the sheets 'Patches' and 'NA' and deletes the data in the 'Patch' sheet that matches with the ones in the 'NA' sheet.
    It should loop with data in the 'patches' sheet with the ones in the 'NA' sheet.
    There are multiple patches (column B) for the same server (Column A). so i want to check whether a server and its patches list in NA sheet matches if so it has to be deleted in the patches sheet.
    I have saved the result data which i want in the 'Result' for your reference.
    Edited
    Attached Files Attached Files

  4. #4
    Quote Originally Posted by Bob Phillips View Post
    Code:
    Option Explicit
    
    Public Sub DeleteMatches()
    Const FORMULA_MATCH As String = _
        "=MATCH(1,(A<row>=NA!A1:A<lastrow>)*(B<row>=NA!B1:B<lastrow>),0)"
    Dim results As Worksheet
    Dim na As Worksheet
    Dim matchFormula As String
    Dim matchrow As Long
    Dim lastna As Long
    Dim lastrow As Long
    Dim i As Long
    
    
        Application.ScreenUpdating = False
        
        On Error Resume Next
        Set results = Worksheets("Result")
        On Error GoTo 0
        If Not results Is Nothing Then
        
            results.Cells.ClearContents
        Else
        
            Set results = Worksheets.Add(after:=Worksheets(Worksheets.Count))
            results.Name = "Result"
        End If
        
        Set na = Worksheets("NA")
        lastna = na.Range("A1").End(xlDown).Row
        matchFormula = Replace(FORMULA_MATCH, "<lastrow>", lastna)
        
        Worksheets("PATCHES").UsedRange.Copy results.Range("A1")
        results.Columns("A:B").AutoFit
        With results
        
            lastrow = .Range("A1").End(xlDown).Row
            For i = lastrow To 2 Step -1
            
                matchrow = 0
                On Error Resume Next
                matchrow = Application.Evaluate(Replace(matchFormula, "<row>", i))
                On Error GoTo 0
                If matchrow > 0 Then
                
                    If .Cells(i, "B").Value = na.Cells(matchrow, "B").Value Then
                
                        .Rows(i).Delete
                    End If
                End If
            Next i
        End With
         
        Application.ScreenUpdating = True
    End Sub
    Its working fine Thanks a lot

    what if i want the result in the 'Patches' sheet itself instead of 'Result' sheet. I mean compare and delete on the 'patches' sheet

  5. #5
    Super Moderator Bob Phillips's Avatar
    Join Date
    Mar 2011
    Posts
    1,823
    Articles
    0
    Excel Version
    O365
    Code:
    Public Sub DeleteMatches()Const FORMULA_MATCH As String = _
        "=MATCH(1,(A<row>=NA!A1:A<lastrow>)*(B<row>=NA!B1:B<lastrow>),0)"
    Dim na As Worksheet
    Dim matchFormula As String
    Dim matchrow As Long
    Dim lastna As Long
    Dim lastrow As Long
    Dim i As Long
    
    
        Application.ScreenUpdating = False
           
        Set na = Worksheets("NA")
        lastna = na.Range("A1").End(xlDown).Row
        matchFormula = Replace(FORMULA_MATCH, "<lastrow>", lastna)
        
        With Worksheets("PATCHES")
        
            lastrow = .Range("A1").End(xlDown).Row
            For i = lastrow To 2 Step -1
            
                matchrow = 0
                On Error Resume Next
                matchrow = Application.Evaluate(Replace(matchFormula, "<row>", i))
                On Error GoTo 0
                If matchrow > 0 Then
                
                    If .Cells(i, "B").Value = na.Cells(matchrow, "B").Value Then
                
                        .Rows(i).Delete
                    End If
                End If
            Next i
        End With
         
        Application.ScreenUpdating = True
    End Sub

  6. #6
    Quote Originally Posted by Bob Phillips View Post
    Code:
    Public Sub DeleteMatches()Const FORMULA_MATCH As String = _
        "=MATCH(1,(A<row>=NA!A1:A<lastrow>)*(B<row>=NA!B1:B<lastrow>),0)"
    Dim na As Worksheet
    Dim matchFormula As String
    Dim matchrow As Long
    Dim lastna As Long
    Dim lastrow As Long
    Dim i As Long
    
    
        Application.ScreenUpdating = False
           
        Set na = Worksheets("NA")
        lastna = na.Range("A1").End(xlDown).Row
        matchFormula = Replace(FORMULA_MATCH, "<lastrow>", lastna)
        
        With Worksheets("PATCHES")
        
            lastrow = .Range("A1").End(xlDown).Row
            For i = lastrow To 2 Step -1
            
                matchrow = 0
                On Error Resume Next
                matchrow = Application.Evaluate(Replace(matchFormula, "<row>", i))
                On Error GoTo 0
                If matchrow > 0 Then
                
                    If .Cells(i, "B").Value = na.Cells(matchrow, "B").Value Then
                
                        .Rows(i).Delete
                    End If
                End If
            Next i
        End With
         
        Application.ScreenUpdating = True
    End Sub

    Perfect !!!! Thank You!!

Posting Permissions

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