Comparing values in columns between 2 sheets

Question

I am trying to write a function in VBA Excel that reads for example A1 and continues to read each line until the end of the values in that column, the function will take the value and lookup this value in sheet2 column A:A if indeed it finds the value it will go to the next cell to the right using the offset() function. Once it has verified that the values match with the values from Sheet1 it will go to the next row (A2) and continue, else if there is a value that does not match it will copy the whole row and paste it on Sheet3 which will show the values not found in sheet2.

This is what I have tried so far however it only copies the first row that does not match and it stops.

Sub citi()
Dim oFSO As Object
Dim arrData() As String
Dim taxid(1 To 65000) As String
Dim amount(1 To 65000) As String
Dim tref(1 To 65000) As String
Dim bnam(1 To 65000) As String
Dim bnknu(1 To 65000) As String
Dim bnkagc(1 To 65000) As String
Dim bbnkac(1 To 65000) As String
Dim citb(1 To 65000) As String
Dim i As Long, j As Long
Set oFSO = CreateObject("Scripting.FileSystemObject")
arrData = Split(oFSO.OpenTextFile("C:\Users\alvaradod\Desktop\citi macro\Import File.txt").ReadAll, vbCrLf)
Sheets("Import").Range("A1").Value = "Tax ID"
Sheets("Import").Range("B1").Value = "Amount"
Sheets("Import").Range("C1").Value = "TReference"
Sheets("Import").Range("D1").Value = "BeneficiaryName"
Sheets("Import").Range("E1").Value = "BankNum"
Sheets("Import").Range("F1").Value = "BankAgency"
Sheets("Import").Range("G1").Value = "BeneficiaryBankAcc"
Sheets("Import").Range("H1").Value = "CitiAcc"
For i = LBound(arrData) To UBound(arrData)
 If Len(arrData(i)) > 0 Then
 j = j + 1
 taxid(j) = Mid(arrData(i), 49, 15)
 amount(j) = Mid(arrData(i), 92, 15)
 tref(j) = Mid(arrData(i), 26, 15)
 bnam(j) = Mid(arrData(i), 257, 34)
 bnknu(j) = Mid(arrData(i), 452, 3)
 bnkagc(j) = Mid(arrData(i), 455, 4)
 bbnkac(j) = Mid(arrData(i), 463, 15)
 citb(j) = Mid(arrData(i), 622, 10)
 End If
Next i
If j > 0 Then
 '' On Error Resume Next
 Sheets("Import").Range("A2").Resize(j).Value = Application.Transpose(taxid)
 Sheets("Import").Range("B2").Resize(j).Value = Application.Transpose(amount)
 Sheets("Import").Range("C2").Resize(j).Value = Application.Transpose(tref)
 Sheets("Import").Range("D2").Resize(j).Value = Application.Transpose(bnam)
 Sheets("Import").Range("E2").Resize(j).Value = Application.Transpose(bnknu)
 Sheets("Import").Range("F2").Resize(j).Value = Application.Transpose(bnkagc)
 Sheets("Import").Range("G2").Resize(j).Value = Application.Transpose(bbnkac)
 Sheets("Import").Range("H2").Resize(j).Value = Application.Transpose(citb)
End If
Set oFSO = Nothing
Erase arrData()
Erase taxid
Erase amount
Erase tref
Erase bnam
Erase bnknu
Erase bnkagc
Erase bbnkac
Erase citb
i = 0
j = 0
Set oFSO = CreateObject("Scripting.FileSystemObject")
arrData = Split(oFSO.OpenTextFile("C:\Users\alvaradod\Desktop\citi macro\Export File.txt").ReadAll, vbCrLf)
Sheets("Export").Range("A1").Value = "Tax ID"
Sheets("Export").Range("B1").Value = "Amount"
Sheets("Export").Range("C1").Value = "TReference"
Sheets("Export").Range("D1").Value = "BeneficiaryName"
Sheets("Export").Range("E1").Value = "BankNum"
Sheets("Export").Range("F1").Value = "BankAgency"
Sheets("Export").Range("G1").Value = "BeneficiaryBankAcc"
Sheets("Export").Range("H1").Value = "CitiAcc"
For i = LBound(arrData) To UBound(arrData)
 If Len(arrData(i)) > 0 Then
 j = j + 1
 taxid(j) = Mid(arrData(i), 189, 15)
 amount(j) = Mid(arrData(i), 56, 15)
 tref(j) = Mid(arrData(i), 24, 15)
 bnam(j) = Mid(arrData(i), 204, 34)
 bnknu(j) = Mid(arrData(i), 296, 3)
 bnkagc(j) = Mid(arrData(i), 299, 4)
 bbnkac(j) = Mid(arrData(i), 345, 15)
 citb(j) = Mid(arrData(i), 284, 10)
 End If
Next i
If j > 0 Then
 '' On Error Resume Next
 Sheets("Export").Range("A2").Resize(j).Value = Application.Transpose(taxid)
 Sheets("Export").Range("B2").Resize(j).Value = Application.Transpose(amount)
 Sheets("Export").Range("C2").Resize(j).Value = Application.Transpose(tref)
 Sheets("Export").Range("D2").Resize(j).Value = Application.Transpose(bnam)
 Sheets("Export").Range("E2").Resize(j).Value = Application.Transpose(bnknu)
 Sheets("Export").Range("F2").Resize(j).Value = Application.Transpose(bnkagc)
 Sheets("Export").Range("G2").Resize(j).Value = Application.Transpose(bbnkac)
 Sheets("Export").Range("H2").Resize(j).Value = Application.Transpose(citb)
End If
Set oFSO = Nothing
Erase arrData
''new code
Dim r As Excel.Range
Dim cell As Excel.Range
Set r = Sheet2.Range(Sheet2.Cells(1, 1), Sheet2.Cells(Rows.Count, 1).End(xlUp))
Dim curRowSheet1 As Long
curRowSheet1 = 1
For Each cell In r
 On Error Resume Next
 Set rfind = Sheet3.Range("C:C").Find(cell.Value)
 On Error GoTo 0
 If (rfind Is Nothing) Then
 cell.EntireRow.Copy Sheet1.Cells(curRowSheet1, 1)
 curRowSheet1 = curRowSheet1 + 1
 End If
Next cell

End Sub

• whytheq: please can you add a screen print of an example of the data you have in the sheet "Import" ...is it a table of data or just data in column A?

Answer 1

Here's how my logic would be for this:

1. Loop through Sheet 1
2. For every cell in Sheet 1 column A, go to Sheet 2 and use Range.Find to search for the value in Sheet1 column A
3. If (cell Is Nothing) Then ' copy and paste Sheet1 current row to Sheet3
4. Keep a counter for the current row in Sheet3 and increment it every time you paste a row into Sheet3

Here's a very basic example:

Option Explicit
Sub compare()
 Dim r As Excel.Range
 Dim cell As Excel.Range
 Dim rFind As Excel.Range
 Set r = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(Rows.Count, 1).End(xlUp))
 Dim curRowSheet3 As Long
 curRowSheet3 = 1
 For Each cell In r
 Set rFind = Sheet2.Range("A:A").Find(cell.Value)
 If (rFind Is Nothing) Then
 cell.EntireRow.Copy Sheet3.Cells(curRowSheet3, 1)
 curRowSheet3 = curRowSheet3 + 1
 End If
 Next cell
End Sub

By the way, I should mention that using Range.Find is much, much, much faster than looping through Sheet2 on your own.

Also, you don't need to reset rFind to Nothing every time at the end of the loop because Range.Find will return Nothing if nothing is found, otherwise, it will return a Range object.

• tigeravatar: No, they can be safely removed
• Alfredo A.: Hi Joseph4tw, the code seems to work, however I am having the same problem as I was having with my original code that It is pasting the rows with error on A1 therefore it is pasting the data on top of one another which leaves me at the end with the last row with error instead of displaying all lines that do not match.
• Joseph: @whytheq I think I did it out of habit when I wrote some other "standard" logical piece of code in the past. I forget now what it was for, but nonetheless, they can be removed and I'll update the answer
• Alfredo A.: @joseph4tw after analyzing the data it seems it returns the values that match, however I am looking for the macro to return the values that do not match with both sheets, do you have an idea of what the change would be?
• Joseph: @AlfredoA. not sure. The If statement only evaluates to true if the cell in Sheet1 is not found in Sheet2. Can you edit your question and include the new code?

Answer 2

I wrote something to compare two worksheets in two different workbooks, this is a modified version of my code:
It will print every difference between your "Export" sheet and "Import" sheet onto your "Err" sheet. You have "C2:C25" so I used 25, but if you need more or less columns, change the numColumns value.

Sub findDifferentCells()
 Dim prevSheet As Worksheet
 Dim currSheet As Worksheet
 Dim writingSheet As Worksheet
 Dim x As Integer
 Dim y As Integer
 Dim numColumns As Integer
 Dim endOfCurr As Integer
 Set prevSheet = ThisWorkbook.Sheets("Import")
 Set currSheet = ThisWorkbook.Sheets("Export")
 Set writingSheet = ThisWorkbook.Sheets("Err")
 numColumns = 25
 endOfCurr = currSheet.Cells(Rows.count, 1).End(xlUp).Offset(1).Row
 'Compare values of both worksheets:
 For x = 0 To endOfCurr
 For y = 0 To numColumns
 If prevSheet.Range("A1").Offset(x, y).Value <> currSheet.Range("A1").Offset(x, y).Value Then
 writingSheet.Range("A1").Offset(x, y).Value = currSheet.Range("A1").Offset(x, y).Value
 End If
 Next y
 Next x
 'Clean-up:
 Set currSheet = Nothing
 Set writingSheet = Nothing
 Set prevSheet = Nothing
End Sub

Hope that works for your problem, if not let me know.