Solved

Excel Compare 2 sheets and delete row if it isn't in master

Posted on 2014-02-28
5
758 Views
Last Modified: 2014-06-27
Hello All,

I thank you for taking the time to look at this for me. I admit I am not a programmer or versed well in coding.  I have a years worth of excel spreadsheets to compare to a master spreadsheet and remove any rows that do not match the master spreadsheet.  I would be able to use Column "D" as the one to compare from.  I can manually go through each sheet and compare each row and delete manually but if I can do this with some coding to make this easier it would be so much better as I know this will be an ongoing thing to do for them.  Sheet 1 is my master sheet and sheet 2 is the one I need to delete any rows that do not appear in sheet 1.  If anyone has a VBA code that I could use would be so helpful.  Thank you in advance for your time and effort.
0
Comment
Question by:IT Tech
  • 3
5 Comments
 
LVL 14

Expert Comment

by:Zac Harris
ID: 39895889
Try these two out:

Use this one if there are no headers:

Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Cells(Rows.Count,"A").End(xlup).Row

' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count,"A").End(xlup).Row)
   ' Loop through all records in the second list.
   For iCtr = iListCount to 1 Step -1
      ' Do comparison of next record.
      ' To specify a different column, change 1 to the column number.
      If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
         ' If match is true then delete row.
         Sheets("Sheet2").Cells(iCtr, 1).EntireRow.Delete
       End If
   Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Open in new window


Use this one if there are headers:

Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Cells(Rows.Count,"A").End(xlup).Row

' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count,"A").End(xlup).Row)
   ' Loop through all records in the second list.
   For iCtr = iListCount to 2 Step -1
      ' Do comparison of next record.
      ' To specify a different column, change 1 to the column number.
      If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
         ' If match is true then delete row.
         Sheets("Sheet2").Cells(iCtr, 1).EntireRow.Delete
       End If
   Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Open in new window


These two VBA's were built off of a Microsoft example script
0
 

Author Comment

by:IT Tech
ID: 39896066
Thank you for the quick response on this one.  I appreciate the help on it.  I have tried the VBA in my spreadsheet setup and found that it did not actually delete the rows from the other spreadsheet.  I am attaching my spreadsheet for you to look at.  I also have noticed that the "Master" sheet has some rows that are not in the "Edited" Sheet.  If at all possible can we delete the rows in the "Edited" sheet that are not in the "Master" sheet and also add the rows that are in the "Master" sheet that do not appear in the "Edited" sheet?  Again I apologize for my lack of knowledge in VBA.
January-2013--VBA-.xlsm
0
 
LVL 14

Accepted Solution

by:
Faustulus earned 500 total points
ID: 39899170
This code should do the job:-
Sub SyncSheets()

    ' you can change the sheet names here:-
    Const Master As String = "Master"
    Const Comp As String = "Edited"
    
    Dim WsM As Worksheet                    ' Master
    Dim WsC As Worksheet                    ' Comp
    Dim Rng As Range                        ' look-up range
    Dim Rm As Long, Rc As Long, Rl As Long  ' rows
    Dim n As Integer                        ' number
    Dim Msg As String
    
    With ThisWorkbook
        Set WsM = .Sheets(Master)
        Set WsC = .Sheets(Comp)
    End With
    Application.ScreenUpdating = False
    
    ' Delete rows in Comp which are not in Master
    Set Rng = SetRange(NwsFirstDataRow, NwsCompare, LastRow(NwsCompare, WsM), , WsM)
    Rl = Rng.Cells.Count
    For Rc = LastRow(NwsCompare, WsC) To NwsFirstDataRow Step -1
        With WsC.Rows(Rc)
            If FindRow(.Cells(NwsCompare).Value, Rng, Rl) = 0 Then
                .EntireRow.Delete
                n = n + 1
            End If
        End With
    Next Rc
    Msg = n & " rows were deleted from and" & vbCr
    
    ' Append additional rows from Master to Comp
    n = 0
    Set Rng = WsC.Columns(NwsCompare)
    Rl = LastRow(NwsCompare, WsM)
    For Rm = NwsFirstDataRow To Rl
        With WsM.Rows(Rm)
            If FindRow(.Cells(NwsCompare).Value, Rng) = 0 Then
                .EntireRow.Copy Destination:=WsC.Cells(LastRow(, WsC) + 1, 1)
                n = n + 1
            End If
        End With
    Next Rm
    Msg = Msg & n & " rows were added to worksheet " & _
          Chr(34) & Comp & Chr(34)
          
    Application.ScreenUpdating = True
    MsgBox Msg, vbInformation, "Modifications report"
End Sub

Open in new window

Note that the above procedure refers to supporting functions and an enum all of which are joined in the code module SyncMan in the attached workbook. Best way, just drag the entire module into your own project in VBE's Project Explorer window while both workbooks are open.

Please note that there is a problem which I didn't resolve. When you run the procedure SyncSheets repeatedly 5 items will be deleted and added every time. Logically, there should be none to add or delete when repeated. The 5 items in question have numbers longer than Excel can handle as numbers. So, Excel converts them to scientific notations which the Find method I am using doesn't appear to handle. Examples are in rows 32 and 289 of the Master sheet. Hopefully, the whole thing won't have any significance, and if it does, perhaps you can identify and handle those few items manually.

There are a few variables in the code that you can change without knowledge of VBA. You find them at the top of the 'SyncMan' code sheet and I repeat them here. Should you require further explanation for this feature of my code please don't hesitate to ask.
    Private Enum Nws                ' Worksheet navigation
    ' The specified rows and columns apply to both sheets
    ' You can change the specs here:-
        NwsFirstDataRow = 2
        NwsCompare = 4              ' 4 = column D
    End Enum
    
Sub SyncSheets()

    ' you can change the sheet names here:-
    Const Master As String = "Master"
    Const Comp As String = "Edited"

Open in new window

EXX-140302-Sync-Sheets.xlsm
0
 

Author Comment

by:IT Tech
ID: 39901291
Thank you for the response, I will try this code out and let you know how it went.
0
 

Author Closing Comment

by:IT Tech
ID: 40163626
Apologize for the delay in response on this. I had been swamped with work.  I thank you for the help and this solution helped me greatly.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Moving applications to the cloud or switching services to cloud-based ones, is a stressful job.  Here's how you can make it easier.
A Short Story about the Best File Recovery Software – Acronis True Image 2017
Viewers will learn how to maximize accessibility options in an Excel workbook for users with accessibility issues.
Video by: Zack
Viewers will learn about using Excel in a browser with Excel Online.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now