CODEWITHSUNDEEP
excelvbscriptvba
Sujith
Sujith

Reputation: 51

Compare first column in each of two Excel sheets and update the differences to a text file

We want to compare the output of the first column in two different Excel sheets and update the differences to a text file. This is comparing only A1 data in excel1 with A1 data of excel2 and appending to the text file:

Dim objExcel,ObjWorkbook,objsheet,ObjWorkbook1,objsheet1,Originalvalue,filesys, filetxt

Const ForReading = 1, ForWriting = 2, ForAppending = 8 

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("D:\Test\copy.xlsx")
set objsheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objWorkbook1 = objExcel.Workbooks.Open("D:\Test\Original.xlsx")
set objsheet1 = objExcel.ActiveWorkbook.Worksheets(1)

Originalvalue = objsheet.Cells(1,1).value

Copyvalue = objsheet1.Cells(1,1).value

If Originalvalue = Copyvalue then

Set filesys = CreateObject("Scripting.FileSystemObject") 
Set filetxt = filesys.OpenTextFile("D:\Test\output.txt", ForAppending, True) 
filetxt.WriteLine(Originalvalue) 
filetxt.Close

msgbox Originalvalue

else 

Set filesys = CreateObject("Scripting.FileSystemObject") 
Set filetxt = filesys.OpenTextFile("D:\Test\output.txt", ForAppending, True) 
filetxt.WriteLine(Copyvalue) 
filetxt.Close

msgbox Copyvalue

End If

objExcel.ActiveWorkbook.Close
objExcel.Workbooks.Close
objExcel.Application.Quit

How can this be done for all the data in the A column please?

Upvotes: 1

Views: 126

Answers (1)

neuralgroove
neuralgroove

Reputation: 580

This compares the files and if there is a different value in the copy file it is placed into the text file..if the values are equal, they are ignored..not sure if thats the behavior you are looking for, but you can at least see how to loop through the files to compare all the records

Dim objExcel, ObjWorkbook, objsheet, ObjWorkbook1, objsheet1, Originalvalue, filesys, filetxt
Dim objsheet_LastRow As Long, objsheet1_LastRow, LastRow As Long, RowCounter As Long, CopyValue

Const ForReading = 1, ForWriting = 2, ForAppending = 8

'are you doing this because you are running this outside of excel?
'if not then this doesn't have to look as complicated as it is

Set objExcel = CreateObject("Excel.Application")
Set ObjWorkbook = objExcel.Workbooks.Open("D:\Test\copy.xlsx")
Set objsheet = objExcel.ActiveWorkbook.Worksheets(1)
Set ObjWorkbook1 = objExcel.Workbooks.Open("D:\Test\Original.xlsx")
Set objsheet1 = objExcel.ActiveWorkbook.Worksheets(1)

Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile("D:\Test\output.txt", ForAppending, True)

'find the last row of data in each sheet, this will only go the end of the shorter file
objsheet_LastRow = objsheet.Cells(100000, 1).End(xlUp).Row
objsheet1_LastRow = objsheet1.Cells(100000, 1).End(xlUp).Row
LastRow = Application.WorksheetFunction.Min(objsheet_LastRow, objsheet1_LastRow)

For RowCounter = 1 To LastRow
    Originalvalue = objsheet.Cells(RowCounter, 1).Value
    CopyValue = objsheet1.Cells(RowCounter, 1).Value
    'if values are different, put the new value in a txt file
    If Originalvalue <> CopyValue Then filetxt.WriteLine (CopyValue)
Next RowCounter

filetxt.Close
ObjWorkbook.Close False
ObjWorkbook1.Close False
'objExcel.ActiveWorkbook.Close
'objExcel.Workbooks.Close
objExcel.Application.Quit

TODO: error trapping

Upvotes: 1

Related Questions