CODEWITHSUNDEEP
vbaexcel
Leighholling
Leighholling

Reputation: 58

VBA to compare two sheets and copy certain columns in the row if they are different

what I'm trying to do is look at 2 different sheets to compare people and their National insurance Number.

Sheet 1 is one set of data from one system and Sheet 2 is another set of data from a different system. What I want to do is firstly compare column 1 in both sheets which contains an id unique to that person , once the entry in column1 on in each sheet are the same and this is then the same person. Then

What I then want to do is compare the value that's stored 17 columns to the right of column 1 on Sheet 1 and 23 Columns to the right on Sheet 2 (Both are national insurance numbers).

Only if they are different then I want to copy the first 3 columns of the row from Sheet 1 (Number, FirstName and Surname) and the national insurance number value from both sheets (Sheet1(0,17)Sheet2(0,23) to Sheet3.

This is code I am trying that instiallially copies entire row which if the logic worked I could change to copy only the cells I want but to no avail it seems to be copying almost the entire sheet 1.....

Sub compareData()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Long, j As Long
    Dim newSheetPos As Integer

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Set ws3 = ActiveWorkbook.Sheets("Sheet3")

    newSheetPos = ws3.Cells(ws3.Rows.Count, 2).End(xlUp).Row

    For i = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
        For j = 1 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
            If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value Then
                If ws1.Cells(i, 17).Value <> ws2.Cells(j, 23).Value Then
                    ws1.Cells(j, 1).EntireRow.Copy ws3.Cells(newSheetPos, 1)
                    newSheetPos = newSheetPos + 1
                Else
                End If
            Else
            End If
        Next j
    Next i
End Sub

Upvotes: 0

Views: 681

Answers (2)

Leighholling
Leighholling

Reputation: 58

Hello I have sorted this now, I realised that as the offset starts from 1 and not 0 that I had to increment the criteria offset by 1 please see below

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Long, j As Long
    Dim newSheetPos As Integer

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Set ws3 = ActiveWorkbook.Sheets("NINO Differences")

    newSheetPos = ws3.Cells(ws3.Rows.Count, 2).End(xlUp).Row

    For i = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
        For j = 1 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row

            If Trim(ws1.Cells(i, 1).Value2) = Trim(ws2.Cells(j, 1).Value2) Then

                If Trim(ws1.Cells(i, 17).Value2) <> Trim(ws2.Cells(j, 24).Value2) Then
                    ws1.Cells(j, 1).EntireRow.Copy ws3.Cells(newSheetPos, 1)
                    newSheetPos = newSheetPos + 1
                Else
                End If
            Else
            End If

        Next j
    Next i

Upvotes: 0

Jamie Riis
Jamie Riis

Reputation: 411

Having run into similar problems, I have found that using Trim(), UCase() and the .Value2 property eliminate many of mismatches caused by formatting and/or text case. Your code should look something like this if you use Trim() and .Value2.

If Trim(ws1.Cells(i, 1).Value2) = Trim(ws2.Cells(j, 1).Value2) Then
    If Trim(ws1.Cells(i, 17).Value2) <> Trim(ws2.Cells(j, 23).Value2) Then
        ws1.Cells(j, 1).EntireRow.Copy ws3.Cells(newSheetPos, 1)
        newSheetPos = newSheetPos + 1
    Else
    End If
End If

The value stored in a cell can be referenced by .Text, .Value or .Value2. Value2 provides the underlying value without any formating. TEXT vs VALUE vs VALUE2 is a link to an article providing an excellent explanation.

Upvotes: 0

Related Questions