locked
Compare two excel sheets RRS feed

  • Question

  • Hi,

    I have some data in two sheets of an excel workbook. I would like to compare them and want to be displayed only unmatched data of both the sheets. For example, in Sheet1, I have data in B Column & in Sheet2, I have data in Column A. Comparison needs to be done in both the ways so that data which are present in Sheet1 but not in Sheet2 & data which are present in Sheet2 but not in Sheet1 should display in Sheet3.

    I have the i/p data as follows:

    Sheet1 Sheet2
    100 200
    200 100
    300 600
    400 300
    500 700

    O/p will be las follows:(Should be displayed in Sheet3):

    Sheet1 but not in Sheet2 Sheet2 but not in Sheet1
    400 600
    500 700

    Note: Comparison should be started from Row2 as I'm using Row1 as header.

    Thank You.


    • Edited by Deb_chatt Saturday, July 25, 2015 6:04 PM
    Saturday, July 25, 2015 6:03 PM

Answers

  • Does anyone have any update on this?

    Private 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(LBound(ThisID))) 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

    • Marked as answer by Deb_chatt Monday, July 27, 2015 6:42 PM
    Sunday, July 26, 2015 11:09 AM
  • Please try..

    Sub compare()
    Worksheets("Sheet1").Cells(1, 3).Value = "Result"
      Dim LRS1 As Long
        With Worksheets("Sheet1")
            LRS1 = .Cells(.Rows.Count, "B").End(xlUp).Row
        End With
    Worksheets("Sheet1").Range("C2").Select
    Worksheets("Sheet1").Range("C2").Formula = "=VLOOKUP(B2,Sheet2!$A$2:$A$100,1,FALSE)" ' change the last row as per your convenience
    Selection.AutoFill Destination:=Worksheets("Sheet1").Range("C2:C" & LRS1)
       
      Worksheets("Sheet2").Cells(1, 2).Value = "Result"
       Dim LRS2 As Long
        With Worksheets("Sheet2")
            LRS2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With
       Worksheets("Sheet2").Activate
       Worksheets("Sheet2").Range("B2").Select
        Worksheets("Sheet2").Range("B2").Formula = "=IF(ISNA(VLOOKUP(A2,Sheet1!$B$2:$B$100,1,FALSE)" ' change the last row as per your convenience
        Selection.AutoFill Destination:=ThisWorkbook.Worksheets("Sheet2").Range("B2:B" & LRS2)
    End Sub
    


    JPP

    • Marked as answer by Deb_chatt Monday, July 27, 2015 6:42 PM
    Sunday, July 26, 2015 5:34 PM

All replies

  • Can you try this?

    Sub TestCompareWorksheets()
        ' compare two different worksheets in the active workbook
        CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
        ' compare two different worksheets in two different workbooks
    '    CompareWorksheets ActiveWorkbook.Worksheets("Sheet1"), _
            Workbooks("WorkBookName.xls").Worksheets("Sheet2")
    End Sub
    
    
    
    Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
    Dim r As Long, c As Integer
    Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
    Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
    Dim rptWB As Workbook, DiffCount As Long
        Application.ScreenUpdating = False
        Application.StatusBar = "Creating the report..."
        Set rptWB = Workbooks.Add
        Application.DisplayAlerts = False
        While Worksheets.Count > 1
            Worksheets(2).Delete
        Wend
        Application.DisplayAlerts = True
        With ws1.UsedRange
            lr1 = .Rows.Count
            lc1 = .Columns.Count
        End With
        With ws2.UsedRange
            lr2 = .Rows.Count
            lc2 = .Columns.Count
        End With
        maxR = lr1
        maxC = lc1
        If maxR < lr2 Then maxR = lr2
        If maxC < lc2 Then maxC = lc2
        DiffCount = 0
        For c = 1 To maxC
            Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
            For r = 1 To maxR
                cf1 = ""
                cf2 = ""
                On Error Resume Next
                cf1 = ws1.Cells(r, c).FormulaLocal
                cf2 = ws2.Cells(r, c).FormulaLocal
                On Error GoTo 0
                If cf1 <> cf2 Then
                    DiffCount = DiffCount + 1
                    Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
                End If
            Next r
        Next c
        Application.StatusBar = "Formatting the report..."
        With Range(Cells(1, 1), Cells(maxR, maxC))
            .Interior.ColorIndex = 19
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
            On Error Resume Next
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
            On Error GoTo 0
        End With
        Columns("A:IV").ColumnWidth = 20
        rptWB.Saved = True
        If DiffCount = 0 Then
            rptWB.Close False
        End If
        Set rptWB = Nothing
        Application.StatusBar = False
        Application.ScreenUpdating = True
        MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
            "Compare " & ws1.Name & " with " & ws2.Name
    End Sub
    
    
    

    Also, if you simply want to color the differences, this simple script will do it for you.

    Sub Compare2Shts()
    For Each Cell In Worksheets("CompareSheet#1").UsedRange
    If Cell.Value <> Worksheets("CompareSheet#2").Range(Cell.Address) Then
    Cell.Interior.ColorIndex = 3
    End If
    Next
    
    For Each Cell In Worksheets("CompareSheet#2").UsedRange
    If Cell.Value <> Worksheets("CompareSheet#1").Range(Cell.Address) Then
    Cell.Interior.ColorIndex = 3
    End If
    Next
    End Sub


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

    Saturday, July 25, 2015 7:02 PM
  • Hi ruguy72,

    Thanks much for your help. I have tested your code and it seems like the code is performing row by row validation which resulted in an incorrect output. 

    If I have a value in A2 of Sheet1, your code is searching for the same value in A2 of Sheet2. If not found then it is assuming it as a mismatch which is incorrect because it is quite possible that the value which is present in A2 of sheet1 might present in A4 or A5 or any other cell apart from A2 of Sheet2. In that case, it should not be a mismatch. Please take a look on my example which I have mentioned above.

    My intention is to find the mismatch between Sheet1 & Sheet2. That means, if any data,  present in Sheet1 but not present in Sheet2 the code will display those data in Sheet3 and vice versa.

    One more comment I have i.e. not sure why your code is creating a new blank workbook. I don't want to create any new workbook. I would like to display the mismatched values in Sheet3 like the same format which I have mentioned above.

    Also, I want to compare B column of Sheet1 with A Column of Sheet2 and vice versa. But currently your code is comparing A - Sheet1 with A- Sheet2.

    Thanks You.

    Saturday, July 25, 2015 7:33 PM
  • Does anyone have any update on this?
    Sunday, July 26, 2015 8:01 AM
  • Does anyone have any update on this?

    Private 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(LBound(ThisID))) 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

    • Marked as answer by Deb_chatt Monday, July 27, 2015 6:42 PM
    Sunday, July 26, 2015 11:09 AM
  • Hi Andreas,

    Not sure what you are trying to achieve. My requirement is very clear & simple and when I  executed your code it's producing some random numbers in red & blue. I'm confused!! :(

    Sunday, July 26, 2015 5:18 PM
  • Please try..

    Sub compare()
    Worksheets("Sheet1").Cells(1, 3).Value = "Result"
      Dim LRS1 As Long
        With Worksheets("Sheet1")
            LRS1 = .Cells(.Rows.Count, "B").End(xlUp).Row
        End With
    Worksheets("Sheet1").Range("C2").Select
    Worksheets("Sheet1").Range("C2").Formula = "=VLOOKUP(B2,Sheet2!$A$2:$A$100,1,FALSE)" ' change the last row as per your convenience
    Selection.AutoFill Destination:=Worksheets("Sheet1").Range("C2:C" & LRS1)
       
      Worksheets("Sheet2").Cells(1, 2).Value = "Result"
       Dim LRS2 As Long
        With Worksheets("Sheet2")
            LRS2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With
       Worksheets("Sheet2").Activate
       Worksheets("Sheet2").Range("B2").Select
        Worksheets("Sheet2").Range("B2").Formula = "=IF(ISNA(VLOOKUP(A2,Sheet1!$B$2:$B$100,1,FALSE)" ' change the last row as per your convenience
        Selection.AutoFill Destination:=ThisWorkbook.Worksheets("Sheet2").Range("B2:B" & LRS2)
    End Sub
    


    JPP

    • Marked as answer by Deb_chatt Monday, July 27, 2015 6:42 PM
    Sunday, July 26, 2015 5:34 PM
  • Not sure what you are trying to achieve.

    My code has all (and even more) what you need. You just need to apply it.

    But that means you have to look in the comments, and then you can understand how it is to be applied.

    You want to compare the values of 2 columns in different sheets, means in fact 2 Range objects. That is what CompareData does.

    The result are 4 Range objects, means which cells are equal or missing in the 1st resp 2nd Range from the input. And with this Range objects you can do what you want. The part in Example_CompareData after the call to CompareData shows some samples.

    When you found a code on the web, don't run it blind and look only at the output. Run it step by step, means debug the code, and look what lines does what in the sheet.

    So you can easily learn apply even complicated codes, because you do not need to understand how CompareData works internally.

    Andreas.



    Monday, July 27, 2015 7:23 AM
  • Thanks Andreas & JPP. I am marking both as answer.
    Monday, July 27, 2015 6:42 PM