0
votes

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
2
Are you sure that both sheets store the NI number in the same format? This may cause the IF Statement to always be false and as such copy most rows?Xabier
Yes they are the Same format 2xUpperCase 6 Numbers and 1 UpperCase and this is what I want. find the match in column 1 on both sheets, look across the row 17 columns sheet 1, 23 across on sheet 2. If the cells do not match then I want to copy the first 3 columns of the mismatched row on sheet1 and National insurance from both. . it will look like this Col1(ID), Col2(FirstName), Col3(Surname), Col4(NINO), Col5(NINO2) the first 4 columns will be from Sheet1 and the 5th from Sheet2Leighholling
Well then there is something else at play here, because your code seems to be ok, you should double check that the formats for all comparisons are the same, and I don't mean the way they are shown on the Cell, but the format of that cell, ie. Text, General, Custom... Could you share some sample data? I've done a simplified test with some dummy data, but it works as expected for me.Xabier
@Leighholling Edit additional info into question. Can you read comfortably what you have posted in the comment?QHarr
No I cannot but I cant put it into an answer to format it, it is sample data deleted it I might even delete this question if im honest. Don't think it can be answeredLeighholling

2 Answers

0
votes

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.

0
votes

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