• 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

I'm getting tired of posters insisting on using their codes and complaining the information given......
 
@ranjitha
1)Yes, maybe You do not care 'present'
but for me 'Present' and 'present' as well for Excel those
are different as well as letters A and B!
2) as many times ... Your needs (3&4) are:
3. if match found place word"present" in sheet 5- col k if not word "removed" in sheet 5 col k
That (above) NEVER HAPPENS! or who would know, what do You really mean?
4. then for all the rows of value "present" from sheet 5 should get replaced with sheet 2 rows(complete row)My code makes 'present' to sheet 5 but ... terms 'replaced with...' is again interesting ... If someone else would figure that, then Okay ... but not in this side of World.
> I have asked sample results too ... but, maybe 'mission impossible'?
 
jindon said:
I'm getting tired of posters insisting on using their codes and complaining the information given......
Click to expand...

i am not sure about how this site works, but we never specify anyone to work on our requirements, we just ask help,not sure why people are so much worried, interested one's can help or else can take their ways off...
 
vletm said:
@ranjitha
1)Yes, maybe You do not care 'present'
but for me 'Present' and 'present' as well for Excel those
are different as well as letters A and B!
2) as many times ... Your needs (3&4) are:
3. if match found place word"present" in sheet 5- col k if not word "removed" in sheet 5 col k
That (above) NEVER HAPPENS! or who would know, what do You really mean?
4. then for all the rows of value "present" from sheet 5 should get replaced with sheet 2 rows(complete row)My code makes 'present' to sheet 5 but ... terms 'replaced with...' is again interesting ... If someone else would figure that, then Okay ... but not in this side of World.
> I have asked sample results too ... but, maybe 'mission impossible'?
Click to expand...
ok thanks for all your help so far...
 
ranjitha

You are misinterpreting my post. It is not against you.
But if you don't want my solution, that's OK.
I have just replied because you referred to my code, that's all.
 
jindon said:
ranjitha

You are misinterpreting my post. It is not against you.
But if you don't want my solution, that's OK.
I have just replied because you referred to my code, that's all.
Click to expand...
ok thank you...no one need to help me...i am feeling sad...its ok let me try my own code ... i think only i understand my requirements better than anyone else...
 
Just in case if you are missing my last code in post #25 in previous page, I have corrected typo that was in my original code.
 
jindon said:
Just in case if you are missing my last code in post #25 in previous page, I have corrected typo that was in my original code.
Click to expand...
hi, i tried you code....let me send you my cope of excel file.....everything is fine apart from sheet2 rows getting replaced with sheet 5 rows for the values "present"
 

Attachments

  • Copy of ranjitha.xlsm
    736.4 KB · Views: 7
OOps found one more typo...
Code: 
Sub bb()
 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, 12) '★ was 11 instead of 12
                        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
 
jindon said:
OOps found one more typo...
Code: 
Sub bb()
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, 12) '★ was 11 instead of 12
                        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
Click to expand...
yes this is working but one misunderstand, changing rows should happen in sheet 2 not in sheet 5, what evere thr in sheet5 should be copied to sheet2 for "present" rows
 
Update Sheet2...
Code: 
Sub bb()
 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("sheet2").Cells(1).CurrentRegion
        a = .Value
        .Resize(.Rows.Count - 1).Offset(1).Columns("k").Value = "Removed"
    End With
    For i = 3 To UBound(a, 1)
        For Each e In Array(2, 5, 12)
            txt = txt & Chr(2) & a(i, e)
        Next
        If Replace(txt, Chr(2), "") = vbNullString Then Exit For
        dic(txt) = i: txt = vbNullString
    Next
    With Sheets("sheet5").Range("a2").CurrentRegion.Resize(, UBound(a, 2))
        a = .Value
        For i = 1 To UBound(a, 1)
            If a(i, 2) = vbNullString Then Exit For
            For Each e In Array(2, 5, 12)
                txt = txt & Chr(2) & a(i, e)
            Next
            If dic.exists(txt) Then
                Sheets("sheet2").Cells(dic(txt), "k").Value = "Present"
                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
            txt = vbNullString
        Next
        .Value = a: .WrapText = False
    End With
    If dic.Count Then
        With Sheets("sheet2").Cells(1).CurrentRegion
            a = .Value
            For i = 1 To UBound(a, 1)
                For Each e In Array(2, 5, 12)
                    txt = txt & Chr(2) & a(i, e)
                Next
                If (dic.exists(txt)) * (IsArray(dic(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 If
End Sub
 
jindon said:
Update Sheet2...
Code: 
Sub bb()
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("sheet2").Cells(1).CurrentRegion
        a = .Value
        .Resize(.Rows.Count - 1).Offset(1).Columns("k").Value = "Removed"
    End With
    For i = 3 To UBound(a, 1)
        For Each e In Array(2, 5, 12)
            txt = txt & Chr(2) & a(i, e)
        Next
        If Replace(txt, Chr(2), "") = vbNullString Then Exit For
        dic(txt) = i: txt = vbNullString
    Next
    With Sheets("sheet5").Range("a2").CurrentRegion.Resize(, UBound(a, 2))
        a = .Value
        For i = 1 To UBound(a, 1)
            If a(i, 2) = vbNullString Then Exit For
            For Each e In Array(2, 5, 12)
                txt = txt & Chr(2) & a(i, e)
            Next
            If dic.exists(txt) Then
                Sheets("sheet2").Cells(dic(txt), "k").Value = "Present"
                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
            txt = vbNullString
        Next
        .Value = a: .WrapText = False
    End With
    If dic.Count Then
        With Sheets("sheet2").Cells(1).CurrentRegion
            a = .Value
            For i = 1 To UBound(a, 1)
                For Each e In Array(2, 5, 12)
                    txt = txt & Chr(2) & a(i, e)
                Next
                If (dic.exists(txt)) * (IsArray(dic(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 If
End Sub
Click to expand...
jindon said:
Update Sheet2...
Code: 
Sub bb()
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("sheet2").Cells(1).CurrentRegion
        a = .Value
        .Resize(.Rows.Count - 1).Offset(1).Columns("k").Value = "Removed"
    End With
    For i = 3 To UBound(a, 1)
        For Each e In Array(2, 5, 12)
            txt = txt & Chr(2) & a(i, e)
        Next
        If Replace(txt, Chr(2), "") = vbNullString Then Exit For
        dic(txt) = i: txt = vbNullString
    Next
    With Sheets("sheet5").Range("a2").CurrentRegion.Resize(, UBound(a, 2))
        a = .Value
        For i = 1 To UBound(a, 1)
            If a(i, 2) = vbNullString Then Exit For
            For Each e In Array(2, 5, 12)
                txt = txt & Chr(2) & a(i, e)
            Next
            If dic.exists(txt) Then
                Sheets("sheet2").Cells(dic(txt), "k").Value = "Present"
                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
            txt = vbNullString
        Next
        .Value = a: .WrapText = False
    End With
    If dic.Count Then
        With Sheets("sheet2").Cells(1).CurrentRegion
            a = .Value
            For i = 1 To UBound(a, 1)
                For Each e In Array(2, 5, 12)
                    txt = txt & Chr(2) & a(i, e)
                Next
                If (dic.exists(txt)) * (IsArray(dic(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 If
End Sub
Click to expand...



Thank you very much.....thanks a tonnnnnnnnnnnnnnn :)
 
You must log in or register to reply here.
Back
Top