CODEWITHSUNDEEP
vbaexcel
dil
dil

Reputation: 1

Compare two EXCEL worksheets and copy similar data onto a third sheet

I wrote a vba code that would allow me to compare two EXCEL worksheets and paste similar rows to a third sheet. Here it is:

'Same data
'If condition met, copy cells
j = 2
    For i = 2 To OLast_row
    IsEqual = False
    For j = 2 To NLast_row
        If OWS.Cells(i, 1).Value = NWS.Cells(j, 1).Value Then
            For Z = 2 To OLast_clmn
                If OWS.Cells(i, Z).Value = NWS.Cells(j, Z).Value Then
                    IsEqual = True
                Else
                    IsEqual = False

                End If
            Next
            If IsEqual = True Then
            cnt = cnt + 1
                CompareWS.Cells(cnt, 1).Value = same
                For D = 1 To OLast_clmn
                    OWS.Cells(i, D).Copy CompareWS.Cells(cnt, D + 1)
                Next

            End If
        Else
    Next
Next

Sheet1 being "OWS" declared earlier, Sheet2 being "NWS" declared earlier, Sheet2 being "CompareWS" declared earlier

The problem is, this code stops comparing the cells at cell 1 level; for example, if two rows (one in each worksheet) start with the same data, based on this cell the program will consider both rows as identical even if the rest of data don't match.

I suspect "For Z..." condition for not going further than it should, but have no idea how as to how to repair it.

Example of Old data: OldData

Example of New data: NewData

Based on these data, ComparedData would look like: ComparedData

Hope this will help

Thank you in advance for shedding light on this.

Best.

Upvotes: 0

Views: 525

Answers (1)

AcsErno
AcsErno

Reputation: 1615

Credits to @Mark Balhoff: I would try it this way

j = 2
For i = 2 To OLast_row
   IsEqual = False
   For j = 2 To NLast_row
        isequal=true
        For Z = 1 To OLast_clmn
            If OWS.Cells(i, Z).Value <> NWS.Cells(j, Z).Value Then
                IsEqual = False
                exit for
            End If
        Next
        If IsEqual = True Then
              ' copy cells
        End If
   Next
Next

Upvotes: 0

Related Questions