Results 1 to 2 of 2

Thread: Compare two worksheets and List Differences

  1. #1
    Member
    Join Date
    Apr 2011
    Posts
    69
    Rep Power
    14

    Compare two worksheets and List Differences

    I have data in two sheets, one is from last year and other from this year. I want to combine these sheet remove the duplicates and take the difference (movement) in values from last year to this year. i.e (Current year - Last year).

    I have attached the sheet containing the data and requirement.

    Kindly assist.
    Attached Files Attached Files
    ----
    excel_learner
    (Using XL 2007 & 2010)

    -------Learning never stops!

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi,

    Try

    Code:
    Sub kTest()
        
        Dim wksA        As Worksheet
        Dim wksB        As Worksheet
        Dim wksC        As Worksheet
        Dim i           As Long
        Dim n           As Long
        Dim c           As Long
        Dim dic         As Object
        Dim ka, k(), t
        
        Set wksA = ThisWorkbook.Worksheets("A")
        Set wksB = ThisWorkbook.Worksheets("B")
        Set wksC = ThisWorkbook.Worksheets("C")
        
        ka = wksA.UsedRange.Resize(, 8)
        ReDim k(1 To UBound(ka, 1) + 100, 1 To UBound(ka, 2))
        
        Set dic = CreateObject("scripting.dictionary")
            dic.comparemode = 1
        
        For i = 2 To UBound(ka, 1)
            If Len(ka(i, 1)) Then
                If Not dic.exists(CStr(ka(i, 1))) Then
                    n = n + 1
                    For c = 1 To UBound(ka, 2)
                        k(n, c) = ka(i, c)
                    Next
                    dic.Add CStr(ka(i, 1)), Array(n, 1)
                Else
                    t = dic.Item(CStr(ka(i, 1)))
                    For c = 6 To UBound(ka, 2)
                        k(t(0), c) = k(t(0), c) + ka(i, c)
                    Next
                End If
            End If
        Next
        Erase ka
        ka = wksB.UsedRange.Resize(, 8)
        For i = 2 To UBound(ka, 1)
            If Len(CStr(ka(i, 1))) Then
                If Not dic.exists(CStr(ka(i, 1))) Then
                    n = n + 1
                    For c = 1 To UBound(ka, 2)
                        k(n, c) = ka(i, c)
                    Next
                    dic.Add CStr(ka(i, 1)), Array(n, 2)
                Else
                    t = dic.Item(CStr(ka(i, 1)))
                    If t(1) = 1 Then
                        For c = 1 To UBound(ka, 2)
                            If c > 5 Then
                                k(t(0), c) = ka(i, c) - k(t(0), c)
                            ElseIf Len(k(t(0), c)) = 0 Then
                                k(t(0), c) = ka(i, c)
                            End If
                        Next
                    Else
                        For c = 6 To UBound(ka, 2)
                            k(t(0), c) = k(t(0), c) + ka(i, c)
                        Next
                    End If
                End If
            End If
        Next
        
        If n Then
            With wksC
                .UsedRange.Offset(1).ClearContents
                .Range("a2").Resize(n, UBound(k, 2)) = k
                .Range("a2").Resize(n, UBound(k, 2)).EntireColumn.AutoFit
            End With
        End If
        
    End Sub
    HTH
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Did You Know? :: Super Secret Worksheets
    By Transformer in forum Tips, Tricks & Downloads (No Questions)
    Replies: 0
    Last Post: 05-17-2013, 12:32 AM
  2. Delete List Contain Matching from Second List
    By Rajan_Verma in forum Rajan Verma's Corner
    Replies: 12
    Last Post: 10-07-2012, 07:18 PM
  3. compare column a to b and b to a
    By ayazgreat in forum Excel Help
    Replies: 18
    Last Post: 05-07-2012, 04:46 PM
  4. Replies: 1
    Last Post: 11-11-2011, 02:06 PM
  5. Replies: 2
    Last Post: 04-03-2011, 08:25 PM

Tags for this Thread

Posting Permissions

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