Thread: Comapring two excel worksheets and adding or deleting rows as needed

Hi dmreno

A while I'd think...let me know how it goes.

Hi dmreno

Actually the code is significantly less complex with far fewer IO's. I'm assuming you've run the procedure on a COPY of the real file???
Assuming you did, kill the procedure (hold down the escape key...it may take a bit...make a note of the line of code where the procedure break point is) and let me know that line.
Assuming you didn't, I have to assume you have a BACKUP???

Let me play with it for a bit...I can look at eliminating the Copy/Paste stuff...that may speed it up.

Hi David

I should of asked and didn't...which file ALWAYS has the fewer records...OldMel or NewMel?

Hi David
See if this code works any better

Option Explicit
Sub test()
    Dim lr1 As Long
    Dim lr2 As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel2 As Range
    Dim FindString As String

    Application.ScreenUpdating = False
    Set ws1 = Sheet1    'NewMel
    Set ws2 = Sheet2    'OldMel

    lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set rng2 = ws2.Range("A2:A" & lr2)

    'With each value in OldMel Column A, find it in
    'NewMel Column A;  if found, replace NewMel row with OldMel row;
    'if not found do nothing

    For Each cel2 In rng2    'OldMel
        FindString = cel2.Value
        If Trim(FindString) <> "" Then
            With ws1.Range("A2:A" & lr1)
                Set rng1 = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not rng1 Is Nothing Then
'                                        Application.Goto rng1, True
'                    ws2.Range("A" & cel2.Row).EntireRow.Copy
'                    ws1.Range("A" & rng1.Row).PasteSpecial
                    ws1.Range("A" & rng1.Row).Resize(1, 21).Value = ws2.Range("A" & cel2.Row).Resize(1, 21).Value
'                    Application.CutCopyMode = False
                End If
            End With
        End If
    Next cel2
    Application.ScreenUpdating = True
End Sub

Hi David

Then try this code...let me know what works...what doesn't

Option Explicit
Sub test()
    Dim lr1 As Long
    Dim lr2 As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel2 As Range
    Dim FindString As String
    Dim xlCalc As XlCalculation
    
    On Error GoTo ExitPoint
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Set ws1 = Sheet1    'NewMel
    Set ws2 = Sheet2    'OldMel

    lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set rng2 = ws2.Range("A2:A" & lr2)

    'With each value in OldMel Column A, find it in
    'NewMel Column A;  if found, replace NewMel row with OldMel row;
    'if not found do nothing

    For Each cel2 In rng2    'OldMel
        FindString = cel2.Value
        If Trim(FindString) <> "" Then
            With ws1.Range("A2:A" & lr1)
                Set rng1 = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not rng1 Is Nothing Then
                    
                    ws1.Range("A" & rng1.Row).Resize(1, 21).Value = ws2.Range("A" & cel2.Row).Resize(1, 21).Value
                End If
            End With
        End If
    Next cel2
ExitPoint:
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Hi David...the two are the same code and do the same things the same way. The second version turns off calculation so I would expect it to be at least marginally faster.

Hey John,

I finally was able to get it to run on the the main file. Both worked and it took only 5 minutes to run on the 22 K row of information. We are still not sure why they were hangin up on the older files I had, but I did creat a whole new one and it ran perfectly. Thanks again for all your help..

Once again you came through with excellent code that works flawlessly and I greatly appreciate it very much.

David

You're welcome.