VBA comparing two files via rows and copy difference to third file

tatkse11 Posts 1 Registration date Wednesday November 7, 2018 Status Member Last seen November 7, 2018 - Updated on Nov 7, 2018 at 12:23 PM
 Blocked Profile - Nov 7, 2018 at 02:53 PM
Hello everyone!
I'm new to VBA and need your help!
I need two compare two files (File 1 and File 2). I need to compare rows in File 2 to rows in File 1 one to all. If there are rows in File 2 that are different from File 1 or are not exist in File 1, they should be copied to the File 3. Cells that are different should be highlighted. I have working code that copy different cells to the File 3 and need to modify it to copy rows. Number of rows and columns can be variable. Approximate row number is 10000, columns is about 20. Please advice how it can be done.
The code is:

Private Sub CommandButton1_Click()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim jRow As Long
Dim iCol As Long

Dim wbkA As Excel.Workbook
Dim wshA As Excel.Worksheet

Dim wbkB As Excel.Workbook
Dim wshB As Excel.Worksheet

Dim wbkC As Excel.Workbook
Dim wshC As Excel.Worksheet

Set wbkA = Workbooks.Open(Filename:="xxxx\Makro\1.xlsm")
Set wbkB = Workbooks.Open(Filename:="xxxx\Makro\2.xlsm")

Set wbkC = Workbooks.Add
wbkC.SaveAs "xxxx\Makro\3.xlsx"
'xxxx - distanation'

For Each wshA In wbkA.Worksheets

Set wshB = wbkB.Worksheets(wshA.Name)

Set wshC = wbkC.Worksheets.Add

wshC.Name = wshA.Name
For i = 1 To wbkA.Sheets.Count

Set varSheetA = wbkA.Worksheets(wbkA.Sheets(i).Name)
Set varSheetB = wbkB.Worksheets(wbkB.Sheets(i).Name)

strRangeToCheck = "A1:DZ200"

Debug.Print Now
varSheetA = varSheetA.Range(strRangeToCheck)
varSheetB = varSheetB.Range(strRangeToCheck)
Debug.Print Now

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then

wshC.Cells(iRow, iCol) = varSheetA(iRow, iCol)
wshC.Cells(iRow, iCol).Interior.Color = RGB(255, 0, 0)
End If
Next i

Next wshA

End Sub

1 reply

Well, this was asked a while ago. It is more than one function. I am offering this as is, and I am not going to script it to make it fit into your model, you do that! This has everything you need to cut and paste together your solution.

Function sheetexist(whatsheet)
On Error GoTo NotExists

sheetexist = True
Exit Function

sheetexist = False

End Function

Function testsheet(whichsheet, rowNum)
nret = sheetexist(whichsheet)
If nret = False Then makesheet (whichsheet)
nret = copyrowX(whichsheet, rowNum)
End Function

Sub makesheet(whatsheet)
On Error GoTo ExitSub
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = whatsheet
End With


End Sub

Function copyrowX(towhatsheet, whatrow)
ThisWorkbook.Worksheets("Sheet1").Range("A" & whatrow).EntireRow.Select

cellcount = Cells(ThisWorkbook.Worksheets(towhatsheet).Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Worksheets(towhatsheet).Range("A" & cellcount).EntireRow.Select

End Function

Sub ReadSheet()
cellcount = Cells(ThisWorkbook.Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
For RowCount = 1 To cellcount
cellvalue = ThisWorkbook.Worksheets("Sheet1").Range("A" & RowCount).Value
nret = testsheet(cellvalue, RowCount)
End Sub

Please read and understand the example I gave you. I did not build it to work as your example, but scripted it for you to learn.
All you need is the comparison of sheets. What happens when one sheet is only one item off, and you end up with all of sheet 2 on sheet 3 even though the items are on sheet 1? I am not going to code for that trap!