• 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...

  • 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

ranjitha

New Member
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
 
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?
 
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)
 

Attachments

  • Book2.xlsx
    52.6 KB · Views: 11
@ranjitha
Are You sure with Your needs?
There are some ... mysteries ...
but I tried to do something like that...
>> press [Do it]-button
 

Attachments

  • ranjitha.xlsb
    85.8 KB · Views: 11
@ranjitha
Are You sure with Your needs?
There are some ... mysteries ...
but I tried to do something like that...
>> press [Do it]-button
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
 
See if this is how you wanted.
Code:
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
 
Hi !​
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)
So try this (with post #3 attachment first)
Edit v3 :​
Code:
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 !
 
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:
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 !
 
@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?
 

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

As On Error may hide others issues …​
 
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.
 
@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!'
 
@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!'
 

Attachments

  • Copy of ranjitha.xlsm
    1,002 KB · Views: 4
@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)
 
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
 
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
 
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:
                    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:
                    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:
                    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
 
@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
 

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 !
 
@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
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
 
This is my last post here.
Code:
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
 
Back
Top