1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro to find diffrence b/w two sheets and copying the diffrence data into another sheet from oldfil

Discussion in 'VBA Macros' started by ranjitha, Mar 17, 2017.

  1. ranjitha

    ranjitha New Member

    Messages:
    22
    hi, below is my code to compare two sheets , but i need this get updated so that i want to compare one perticular col (col D) from both sheets , and what ever data matches it should be marked as present in col M or else removed in one worksheet
    and next step , for all the present (col m) values , it as to compare col i from both sheets, if data match then do nothing else replace those rows from other worksheet to this one worksheet.

    Sub compare()


    Dim varSheetA As Variant
    Dim varSheetB As Variant
    Dim strRangeToCheck As String
    Dim iRow As Long
    Dim iCol As Long
    Dim iRo As Long
    Dim iCo As Long



    strRangeToCheck = "A1:IV25536"
    ' If you know the data will only be in a smaller range, reduce the size of the ranges above.
    Debug.Print Now
    varSheetA = Worksheets("Sheet2").Range(strRangeToCheck)
    varSheetB = Worksheets("Sheet3").Range(strRangeToCheck) ' or whatever your other sheet is.
    Debug.Print Now

    For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)

    For iRo = LBound(varSheetB, 1) To UBound(varSheetB, 1)
    For iCo = LBound(varSheetB, 2) To UBound(varSheetB, 2)

    If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
    ' Cells are identical.
    ' Do nothing.
    Else
    ' Cells are different.
    ' Code goes here for whatever it is you want to do.


    MsgBox "Macro completed successfully @" & Now


    End If
    Next iCo
    Next iRo
    Next iCol
    Next iRow

    End Sub
  2. vletm

    vletm Well-Known Member

    Messages:
    2,263
    Okay ... just for sure
    You would like to compare ALL D-column rows with "Sheet2' and 'Sheet3'.
    if 'match' then mark as present in col M ...
    Q: What kind of mark You need - word 'present'? and in which Sheet?
    or else removed in one worksheet and next step
    Q: Do this means then 'no match'? What remove, row/column...?
    ... hmm. There are a long sentence ... and soon both sheets will be empty or not
    Could You make a drawing or upload file with sample wanted result too?
  3. ranjitha

    ranjitha New Member

    Messages:
    22
    hi,Thanks for your reply,

    please find the attached file,

    1. it need to concatenate-(col - b,e,l) from both sheets and place the result in col d.
    2. find match from both sheets for col d
    3. if match found place word"present" in sheet 5- col k if not word "removed" in sheet 5 col k
    4. then for all the rows of value "present" from sheet 5 should get replaced with sheet 2 rows(complete row)

    Attached Files:

  4. ranjitha

    ranjitha New Member

    Messages:
    22
    and also row wont be same always so it should work for all rows , columns will be constant
  5. vletm

    vletm Well-Known Member

    Messages:
    2,263
    @ranjitha
    Are You sure with Your needs?
    There are some ... mysteries ...
    but I tried to do something like that...
    >> press [Do it]-button

    Attached Files:

  6. ranjitha

    ranjitha New Member

    Messages:
    22
    hi,

    thanks for the code, not sure what is wrong, because i just changed the row entries and run this code, but not working correctly...it is just showing eveyrthing removed with red in sheet 2
  7. jindon

    jindon Well-Known Member

    Messages:
    503
    See if this is how you wanted.
    Code (vb):

    Sub test()
        Dim a, i As Long, ii As Long, e, txt As String, w, dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        dic.CompareMode = 1
        With Sheets("sheet5")
            a = .Range("a1").CurrentRegion.Resize(, .Cells.SpecialCells(11).Column).Value
        End With
        For i = 1 To UBound(a, 1)
            If a(i, 2) <> vbNullString Then
                For Each e In Array(2, 5, 12)
                    txt = txt & Chr(2) & a(i, e)
                Next
                dic(txt) = Empty: txt = vbNullString
            End If
        Next
        With Sheets("sheet2").Range("a1").CurrentRegion.Resize(, UBound(a, 2))
            a = .Value
            For i = 1 To UBound(a, 1)
                If a(i, 2) <> vbNullString Then
                    For Each e In Array(2, 5, 12)
                        txt = txt & Chr(2) & a(i, e)
                    Next
                    a(i, 11) = IIf(dic.exists(txt), "Present", "Removed")
                    If dic.exists(txt) Then
                        ReDim w(1 To UBound(a, 2))
                        For ii = 1 To UBound(a, 2)
                            w(ii) = a(i, ii)
                        Next
                        dic(txt) = w
                    End If
                End If
                txt = vbNullString
            Next
            .Value = a: .WrapText = False
        End With
        For Each e In dic
            If IsEmpty(dic(e)) Then dic.Remove e
        Next
        If dic.Count Then
            With Sheets("sheet5")
                With .Range("a1").CurrentRegion.Resize(, .Cells.SpecialCells(11).Column)
                    a = .Value
                    For i = 1 To UBound(a, 1)
                        For Each e In Array(2, 5, 11)
                            txt = txt & Chr(2) & a(i, e)
                        Next
                        If dic.exists(txt) Then
                            For ii = 1 To UBound(a, 2)
                                If dic(txt)(ii) <> vbNullString Then a(i, ii) = w(ii)
                            Next
                        End If
                        txt = vbNullString
                    Next
                    .Value = a: .WrapText = False
                End With
            End With
        End If
    End Sub
  8. vletm

    vletm Well-Known Member

    Messages:
    2,263
    @ranjitha ... hmmm?
    It is challenge to say 'this or that'
    if You JUST change something and
    You won't send that file here.
  9. Marc L

    Marc L Excel Ninja

    Messages:
    2,916
    Hi !​
    So try this (with post #3 attachment first)
    Edit v3 :​
    Code (vb):
    Sub Demo()
       Const DL = "¤"
         Dim Rg As Range, Rw As Range, R&, S$, V
         Set Rg = Sheet2.UsedRange.Rows
              V = [{2,5,12}]
         Application.ScreenUpdating = False
    With CreateObject("Scripting.Dictionary")
        For R = 1 To Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
            .Item(Join(Application.Index(Rg(R), , V), DL)) = R
        Next
        For Each Rw In Sheet5.UsedRange.Rows
            S = Join$(Application.Index(Rw, , V), DL)
            If .Exists(S) Then Rg(.Item(S)).Copy Rw Else Rw.Cells(11).Value = "Removed"
        Next
            .RemoveAll
    End With
         Set Rg = Nothing
         Application.ScreenUpdating = True
    End Sub
    Do you like it ? So thanks to click on bottom right Like !
    Bomino likes this.
  10. Marc L

    Marc L Excel Ninja

    Messages:
    2,916
    Hi vletm !

    If using MATCH Excel worksheet function in VBA,
    it's better to never use WorksheetFunction statement
    but just Application instead and combined to a Variant variable.
    So this variable can be easily verified via IsError or IsNumeric
    VBA functions and avoiding On Error statement :​
    Code (vb):
    Sub DemoMATCH()
      Const DL = "¤"
        Dim Rg As Range, Rw As Range, W, R&, VA$(), V
        W = [{2,5,12}]
        R = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim VA(1 To R)
        Set Rg = Sheet2.UsedRange.Rows.Resize(R)
    For R = 1 To R
        VA(R) = Join$(Application.Index(Rg(R), , W), DL)
    Next
        Application.ScreenUpdating = False
    For Each Rw In Sheet5.UsedRange.Rows
        V = Application.Match(Join(Application.Index(Rw, , W), DL), VA, 0)
        If IsError(V) Then Rw.Cells(11).Value = "Removed" Else Rg(V).Copy Rw
    Next
        Set Rg = Nothing
        Application.ScreenUpdating = True
    End Sub
    Do you like it ? So thanks to click on bottom right Like !
    Bomino likes this.
  11. vletm

    vletm Well-Known Member

    Messages:
    2,263
    @Marc L
    As I wrote to ranjitha with my original reply with sample file:
    Are You sure with Your needs?
    There are some ... mysteries ...
    but I tried to do something like that...

    That wasn't 'crystal clear' what really ranjitha needs!
    It would be waist of time to try to avoid all possible errors.
    Like: a long time ago I did 'cat'-test!
    Just fill 'cat' to everywhere in sheet and
    still sheet should work without unwanted actions.
    Do You make always in the 1st time the final version,
    version, which cannot make anyway better?
  12. Marc L

    Marc L Excel Ninja

    Messages:
    2,916

    No, it was just to warn you WorksheetFunction may be avoided …

    As On Error may hide others issues …​
  13. ranjitha

    ranjitha New Member

    Messages:
    22
    hi, i just made it clear about my needs in my previous msg-
    1. it need to concatenate-(col - b,e,l) from both sheets and place the result in col d.
    2. find match from both sheets for col d
    3. if match found place word"present" in sheet 5- col k if not word "removed" in sheet 5 col k
    4. then for all the rows of value "present" from sheet 5 should get replaced with sheet 2 rows(complete row)

    not sure what is confusing here.
  14. Marc L

    Marc L Excel Ninja

    Messages:
    2,916


    First try posts #9 & 10 codes with your post #3 attachment ‼
  15. vletm

    vletm Well-Known Member

    Messages:
    2,263
    @ranjitha
    I checked my code again and
    I have already asked You to sent that Your file here to check 'what is going on?'.
    You could also show some sample results too.
    Notes from Your 'needs':
    Like: then for all the rows of value "present" from sheet 5
    For some reason, You have used 'Present'-words not 'present'! Different words!
    as well 'if not word "removed" in sheet 5 col k' means ALL (end of 3.) should do something ...hmm? There are NONE word of "remove" then ... humm?
    'small and CAPITAL letters matters!'
  16. ranjitha

    ranjitha New Member

    Messages:
    22

    Attached Files:

  17. jindon

    jindon Well-Known Member

    Messages:
    503
    Because you have #N/A value in E3755 of Sheet2.
  18. vletm

    vletm Well-Known Member

    Messages:
    2,263
    @ranjitha
    Okay, thank from file,
    BUT You didn't comment this!
    For some reason, You have used 'Present'-words not 'present'! Different words!
    as well 'if not word "removed" in sheet 5 col k' means ALL (end of 3.) should do something ...hmm? There are NONE word of "remove" then ... humm?
    'small and CAPITAL letters matters!'

    So, could You explain very clear what would do here?
    3. if match found place word"present" in sheet 5- col k if not word "removed" in sheet 5 col k
    4. then for all the rows of value "present" from sheet 5 should get replaced with sheet 2 rows(complete row)
  19. ranjitha

    ranjitha New Member

    Messages:
    22
    hi, this code is working fine for marking Present and Removed but it is not replacing the rows, i means as i mentioned in my request -
    for all the rows in sheet2 which are present, it should get replaced with rows sheet5. ( sheet 5 rows need to be copied to sheet 2) only for present values
  20. ranjitha

    ranjitha New Member

    Messages:
    22
    Sub aa()
    Dim a, i As Long, ii As Long, e, txt As String, w, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("sheet5")
    a = .Range("a1").CurrentRegion.Resize(, .Cells.SpecialCells(11).Column).Value
    End With
    For i = 1 To UBound(a, 1)
    If a(i, 2) <> vbNullString Then
    For Each e In Array(2, 5, 12)
    txt = txt & Chr(2) & a(i, e)
    Next
    dic(txt) = Empty: txt = vbNullString
    End If
    Next
    With Sheets("sheet2").Range("a1").CurrentRegion.Resize(, UBound(a, 2))
    a = .Value
    For i = 1 To UBound(a, 1)
    If a(i, 2) <> vbNullString Then
    For Each e In Array(2, 5, 12)
    txt = txt & Chr(2) & a(i, e)
    Next
    a(i, 11) = IIf(dic.exists(txt), "Present", "Removed")
    If dic.exists(txt) Then
    ReDim w(1 To UBound(a, 2))
    For ii = 1 To UBound(a, 2)
    w(ii) = a(i, ii)
    Next
    dic(txt) = w
    End If
    End If
    txt = vbNullString
    Next
    .Value = a: .WrapText = False
    End With
    For Each e In dic
    If IsEmpty(dic(e)) Then dic.Remove e
    Next
    If dic.Count Then
    With Sheets("sheet5")
    With .Range("a1").CurrentRegion.Resize(, .Cells.SpecialCells(11).Column)
    a = .Value
    For i = 1 To UBound(a, 1)
    For Each e In Array(2, 5, 11)
    txt = txt & Chr(2) & a(i, e)
    Next
    If dic.exists(txt) Then
    For ii = 1 To UBound(a, 2)
    If dic(txt)(ii) <> vbNullString Then a(i, ii) = w(ii)
    Next
    End If
    txt = vbNullString
    Next
    .Value = a: .WrapText = False
    End With
    End With
    End If
    End Sub
  21. jindon

    jindon Well-Known Member

    Messages:
    503
    That's my code and I believe my interpretation of your problem is correct.
    Do you want to replace the value completely or put the value only columns that are different?If completely replace the row
    change
    Code (vb):

                        If dic.exists(txt) Then
                            For ii = 1 To UBound(a, 2)
                                If dic(txt)(ii) <> vbNullString Then a(i, ii) = w(ii)
                            Next
                        End If
    to
    Code (vb):

                        If dic.exists(txt) Then
                            For ii = 1 To UBound(a, 2)
                                a(i, ii) = dic(txt)(ii)
                            Next
                        End If
    P.S
    Typo in original code.
    w(ii) should be dic(txt)(ii)
    i.e
    Code (vb):

                        If dic.exists(txt) Then
                            For ii = 1 To UBound(a, 2)
                                If dic(txt)(ii) <> vbNullString Then a(i, ii) = dic(txt)(ii)
                            Next
                        End If
  22. vletm

    vletm Well-Known Member

    Messages:
    2,263
    @ranjitha
    Okay ... You won't answers questions.
    You write something about 'present' but You mean something else...
    You write something about 'removed' but You mean something else...
    and if 'not removed' then do something ...
    but there are not those words!
    ... then Good Luck
  23. Marc L

    Marc L Excel Ninja

    Messages:
    2,916

    ranjitha, with last attachment (which should be the first ! :rolleyes:)
    replace within my code Sheet2 by Sheet1
    and Sheet5 by Sheet2

    As you should replace by Worksheets("name")
    at very beginner level !
  24. ranjitha

    ranjitha New Member

    Messages:
    22
    hi...i wrote about present but i dont care the lower case upper case thing, i just worried about the word present , same thing for removed as well. and your code is working for marking present/removed but it is not replacing the present rows of sheet2 with sheet 5 rows
  25. jindon

    jindon Well-Known Member

    Messages:
    503
    This is my last post here.
    Code (vb):

    Sub test()
        Dim a, i As Long, ii As Long, e, txt As String, w, dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        dic.CompareMode = 1
        With Sheets("sheet5")
            a = .Range("a1").CurrentRegion.Resize(, .Cells.SpecialCells(11).Column).Value
        End With
        For i = 1 To UBound(a, 1)
            If a(i, 2) <> vbNullString Then
                For Each e In Array(2, 5, 12)
                    txt = txt & Chr(2) & a(i, e)
                Next
                dic(txt) = Empty: txt = vbNullString
            End If
        Next
        With Sheets("sheet2").Range("a1").CurrentRegion.Resize(, UBound(a, 2))
            a = .Value
            For i = 1 To UBound(a, 1)
                If a(i, 2) <> vbNullString Then
                    For Each e In Array(2, 5, 12)
                        txt = txt & Chr(2) & a(i, e)
                    Next
                    a(i, 11) = IIf(dic.exists(txt), "Present", "Removed")
                    If dic.exists(txt) Then
                        ReDim w(1 To UBound(a, 2))
                        For ii = 1 To UBound(a, 2)
                            w(ii) = a(i, ii)
                        Next
                        dic(txt) = w
                    End If
                End If
                txt = vbNullString
            Next
            .Value = a: .WrapText = False
        End With
        For Each e In dic
            If IsEmpty(dic(e)) Then dic.Remove e
        Next
        If dic.Count Then
            With Sheets("sheet5")
                With .Range("a1").CurrentRegion.Resize(, .Cells.SpecialCells(11).Column)
                    a = .Value
                    For i = 1 To UBound(a, 1)
                        For Each e In Array(2, 5, 11)
                            txt = txt & Chr(2) & a(i, e)
                        Next
                        If dic.exists(txt) Then
                            For ii = 1 To UBound(a, 2)
                                a(i, ii) = dic(txt)(ii)
                            Next
                        End If
                        txt = vbNullString
                    Next
                    .Value = a: .WrapText = False
                End With
            End With
        End If
    End Sub
     

Share This Page