none
Compare 2 different workbooks and highlight the differences (Excel 2010) RRS feed

  • Frage

  • Good morning and happy Friday to all.

    I hope someone can assist me with the following.

    I have 2 workbooks (separate files) with rows of content. From my understanding there isnt a way per-say to compare 2 worksheets and have the result of the query appear in a blank sheet.

    I took the 2 workbooks and copied their sheet1s into a new workbook (each sheet is labeled Act1 and Act2 respectively).

    Column A in Act1 needs to be compared with Column C in Act2 and if it finds anything different, take the entire row and place it in SheetC.

    The purpose is to compare the 2 sheets and look for things from the first sheet that are not in the second sheet.

    Here is the kicker. Act1 has 197 rows while act2 has 54. however, there are some items that are duplicates based on the content in the column.

    Is there a way to accomplish this?

    Freitag, 25. April 2014 15:31

Alle Antworten

  • Good morning and happy Friday to all.

    I hope someone can assist me with the following.

    I have 2 workbooks (separate files) with rows of content. From my understanding there isnt a way per-say to compare 2 worksheets and have the result of the query appear in a blank sheet.

    I took the 2 workbooks and copied their sheet1s into a new workbook (each sheet is labeled Act1 and Act2 respectively).

    Column A in Act1 needs to be compared with Column C in Act2 and if it finds anything different, take the entire row and place it in SheetC.

    The purpose is to compare the 2 sheets and look for things from the first sheet that are not in the second sheet.

    Here is the kicker. Act1 has 197 rows while act2 has 54. however, there are some items that are duplicates based on the content in the column.

    Is there a way to accomplish this?

    I did my homework. And I guess this might help. Merging two datasets in excel after merging you can do.

    https://www.youtube.com/watch?v=0uWjXuhvqB8


    - please mark correct answers

    Freitag, 25. April 2014 16:13
  • I am not looking to merge the data. I am comparing to look for differences between then and take those differences and place them into an empty sheet in the workbook.
    Freitag, 25. April 2014 16:20
  • Yes sir. After merging into single sheet you can do it

    - please mark correct answers

    Freitag, 25. April 2014 16:39
  • Does anyone else have a different solution that I can use via a VBA macro?
    Freitag, 25. April 2014 16:42
  • Does anyone else have a different solution that I can use via a VBA macro?

    Yes, but you have to customize the call to CompareData for your needs.

    Copy the code below into a regular module, be sure an empty sheet is active, place a breakpoint on the call to CompareData in sub Example_CompareData and run it.

    If the code stops, look into the sheet, then run the rest of the sub. Study the output and the comments in Example_CompareData.

    Note that it doesn't matter where the cells to compare are, you can also compare cells in different files.

    Andreas.

    Sub Example_CompareData()
      Dim i As Integer, j As Integer
      Dim Equal(1 To 2) As Range
      Dim Missing(1 To 2) As Range
     
      If MsgBox("This example erases all data in the active sheet! Continue?", _
        vbOKCancel + vbDefaultButton2, "Example_CompareData") = vbCancel Then Exit Sub
     
      'Create some example data
      Cells.Clear
      For i = 0 To 5 Step 5
        Range("A1").Offset(0, i).Resize(1, 4) = _
          Array("Nr", "HeaderA", "HeaderB", "HeaderC")
        For j = 1 To 25 'Increase this number for more rows
          Range("A1").Offset(j, i).Resize(1, 4) = _
            Array(j, Int(10 * Rnd), Int(10 * Rnd), Int(10 * Rnd))
        Next
      Next
     
      'Compare the columns which heading is "HeaderA" and "HeaderC"
      CompareData _
        Intersect(Range("A:D"), ActiveSheet.UsedRange), Array("HeaderA", "HeaderC"), _
        Intersect(Range("F:I"), ActiveSheet.UsedRange), Array("HeaderA", "HeaderC"), _
        Equal(1), Equal(2), Missing(1), Missing(2), xlYes
       
      'Color the results: blue = equal data, red = missing data
      For i = 1 To 2
        If Not Equal(i) Is Nothing Then Equal(i).Font.Color = vbBlue
        If Not Missing(i) Is Nothing Then Missing(i).Font.Color = vbRed
      Next
     
      'Copy the equal data from first range to column K
      Range("A1:D1").Copy Range("K1")
      Equal(1).Copy Range("K2")
     
      'Copy the missing data from first range to column P
      Range("A1:D1").Copy Range("P1")
      Missing(1).Copy Range("P2")
    End Sub
    
    Sub CompareData( _
        ByVal R1 As Range, ByVal ID1, _
        ByVal R2 As Range, ByVal ID2, _
        Optional ByRef Equal1 As Range, Optional ByRef Equal2 As Range, _
        Optional ByRef Missing1 As Range, Optional ByRef Missing2 As Range, _
        Optional ByVal Header As XlYesNoGuess = xlNo, _
        Optional ByVal Compare As VbCompareMethod = vbBinaryCompare)
      'Compares R1 with R2 by rows
      '  ID could be a single value or an array of values with:
      '    a column number: 1 to Columns.Count of R1 or R2
      '    a column name: "A" to "IV" resp. "XFD" in XL2007 and above
      '    if Header = xlYes then
      '    a heading: must be somewhere in the first row
      '  Returns ranges with all equal and missing cells
      Const ErrNum = 1000
      Dim Dict(1 To 2) As Object 'Scripting.Dictionary
      Dim Data() As Variant
      Dim Index() As Long
      Dim ThisR As Range, ThisE As Range, ThisM As Range, TempR As Range
      Dim ThisID As Variant, Temp As Variant
      Dim i As Integer, j As Integer
      Dim rw As Long, cl As Long
      Dim Key As String
    
      If Header = xlGuess Then
        Err.Raise ErrNum, "CompareData", "Header=xlGuess is not supported"
      End If
     
      'Step 1: Initialize
     
      For i = 1 To 2
        'Get the appropriate variables
        If i = 1 Then
          Set ThisR = R1
          ThisID = ID1
          If Not IsArray(ThisID) Then
            ReDim ThisID(0 To 0)
            ThisID(0) = ID1
          End If
        Else
          Set ThisR = R2
          ThisID = ID2
          If Not IsArray(ThisID) Then
            ReDim ThisID(0 To 0)
            ThisID(0) = ID2
          End If
        End If
        If ThisR Is Nothing Then
          Err.Raise ErrNum, "CompareData", "R" & i & " is nothing"
        End If
        If IsMissing(ThisID(0)) Then
          Err.Raise ErrNum, "CompareData", "ID" & i & " is missing"
        End If
    
        'Read in all data
        Data = ThisR.Value2
        If Not IsArray(Data) Then
          ReDim Data(1 To 1, 1 To 1)
          Data(1, 1) = ThisR.Value2
        End If
        If Header = xlYes And UBound(Data) < 2 Then
          Err.Raise ErrNum, "CompareData", "R" & i & ": not enough rows"
        End If
    
        'Create the dictionary
        Set Dict(i) = CreateObject("Scripting.Dictionary")
        If Compare = vbTextCompare Then Dict(i).CompareMode = vbTextCompare
    
        ReDim Index(LBound(ThisID) To UBound(ThisID))
        If Header = xlYes Then
          'Parse the header
          For j = LBound(ThisID) To UBound(ThisID)
            For cl = 1 To UBound(Data, 2)
              If StrComp(ThisID(j), CStr(Data(1, cl)), Compare) = 0 Then
                Index(j) = cl
                Exit For
              End If
            Next
            If Index(j) = 0 Then
              Err.Raise ErrNum, "CompareData", _
                "ID" & i & ": Header " & ThisID(j) & " not found"
            End If
          Next
        Else
          'Parse the columns
          On Error Resume Next
          For j = LBound(ThisID) To UBound(ThisID)
            If IsNumeric(ThisID(j)) Then
              Index(j) = ThisID(j)
            Else
              Set TempR = Intersect(ThisR.Parent.Columns(ThisID(j)), ThisR)
              If Not TempR Is Nothing Then
                Index(j) = TempR.Column - ThisR.Column + 1
              End If
            End If
            If Index(j) < 1 Or Index(j) > UBound(Data, 2) Then
              On Error GoTo 0
              Err.Raise ErrNum, "CompareData", _
                "ID" & i & ": Column " & ThisID(j) & " not inside R" & i
            End If
          Next
          On Error GoTo 0
        End If
       
        'Create the dictionary from the data
        For rw = IIf(Header = xlYes, 2, 1) To UBound(Data)
          Key = CStr(Data(rw, Index(LBound(ThisID))))
          For j = LBound(ThisID) + 1 To UBound(ThisID)
            Key = Key & vbNullChar & CStr(Data(rw, Index(j)))
          Next
          'Store the row numbers
          If Not Dict(i).Exists(Key) Then
            Dict(i).Add Key, Array(rw)
          Else
            Temp = Dict(i)(Key)
            ReDim Preserve Temp(LBound(Temp) To UBound(Temp) + 1)
            Temp(UBound(Temp)) = rw
            Dict(i)(Key) = Temp
          End If
        Next
      Next
     
      'Step 2: Compare the dictionaries and build the results
     
      For i = 1 To 2
        j = i Mod 2 + 1
        'Get the appropriate variables
        If i = 1 Then
          Set ThisR = R1
          Set ThisE = Equal1
          Set ThisM = Missing1
        Else
          Set ThisR = R2
          Set ThisE = Equal2
          Set ThisM = Missing2
        End If
       
        'Get the keys and search them in the other dictionary
        Data = Dict(i).keys
        For rw = LBound(Data) To UBound(Data)
          Key = Data(rw)
          Temp = Dict(i)(Key)
          If Dict(j).Exists(Key) Then
            For cl = LBound(Temp) To UBound(Temp)
              If ThisE Is Nothing Then
                Set ThisE = ThisR.Rows(Temp(cl))
              Else
                Set ThisE = Union(ThisE, ThisR.Rows(Temp(cl)))
              End If
            Next
          Else
            For cl = LBound(Temp) To UBound(Temp)
              If ThisM Is Nothing Then
                Set ThisM = ThisR.Rows(Temp(cl))
              Else
                Set ThisM = Union(ThisM, ThisR.Rows(Temp(cl)))
              End If
            Next
          End If
        Next
       
        'Set the appropriate variables
        If i = 1 Then
          Set R1 = ThisR
          Set Equal1 = ThisE
          Set Missing1 = ThisM
        Else
          Set R2 = ThisR
          Set Equal2 = ThisE
          Set Missing2 = ThisM
        End If
      Next
    End Sub
    

    Freitag, 25. April 2014 17:56
  • hmmm you sort of lost me there, perhaps if I provide samples of what my 2 sheets look like

    Sheet 1 called Act1 has the following data below and the criteria we want to check is Column A

    A B C D E F  G
    Case Number Filing Date Patent Number Petitioner Patent Owner Status Documents
    IPR2012-00001 9/16/2012 6778074 Garmin International, Inc. Cuozzo Speed Technologies LLC Final Decision Final Written Decision - 35 U.S.C. 318(a) and 37 C.F.R. 42.73 (59)
    IPR2012-00004 9/16/2012 6422291 MACAUTO U.S.A. BOS GmbH &amp; Co. KG Pending Judgment - Termination of the Proceeding - 37 CFR 42.73 (23)
    IPR2012-00005 9/16/2012 6653215 Nichia Corporation Emcore Corporation Final Decision Final Written Decision (68)
    IPR2012-00006 9/16/2012 7713698 Illumina, Inc. The Trustees of Columbia University in the City of New York Instituted Final Written Decision (128)

    Sheet 2 called Act2 has the following data below and the criteria we want to check is Column C

    A B C D
    Index No. Key IPR matter Patent
    2 1 CBM2012-00002 7877269
    3 1 CBM2012-00003 8140358
    12 2 IPR2012-00001 6778074
    13 2 IPR2012-00005 6653215
    14 2 IPR2012-00006 7713698
    15 2 IPR2012-00007 7790869
    16 2 IPR2012-00018 7566960
    17 2 IPR2012-00019 8062968
    18 2 IPR2012-00020 8058897
    19 2 IPR2012-00023 7994609
    20 2 IPR2012-00026 6757717
    21 2 IPR2012-00027 7591303
    22 2 IPR2012-00042 6240376
    24 2 IPR2013-00004 7831926
    25 2 IPR2013-00005 6444533
    26 2 IPR2013-00006 6888204

    So the macro you just provided, this will scan both sheets in the specific columns and if it finds something different, take the entire row and place it into Sheet labeled Act3

    I hope it makes sense now

    Freitag, 25. April 2014 18:36
  • perhaps if I provide samples of what my 2 sheets look like

    If I copy the data from my browser and paste it into Excel, I can't see the same result as you describe.

    Please make a sample file, upload it on an online file hoster like www.dropbox.com and post the download link here.

    Andreas.

    Samstag, 26. April 2014 08:48
  • How about this?

    http://download.cnet.com/Beyond-Compare/3000-2242_4-10015731.html?tag=dre


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Samstag, 26. April 2014 17:29