ee)b) = PROJECT Compare Two Excel Files re Igor Krupitsky 19 Jan 2021 CPOL How to compare two Excel Files using VBS In this post, you will see how to drag and drop two Excel files to compare. Download source code - 24.3 KB Introduction Drag and drop two Excel files to compare. @ chess -Cel.xlsx Chess - Row.xsx 1B} Chess.xsx (2) bxceComparevbs {8 EecaRonComparaiee Tow The changes will be highlighted in yellow. Use ExcelCompare.vbs to compare cells.eee 1 2 3 4 5 6 Ey " 2 3 If your Excel files might have new rows or columns, use ExcelRowCompare.vbs. Using the Code ExcelRowCompare.vbs compares rows, column and cells. You can modify the code to exclude some worksheets or to save the file at the end. The script might take a long time to run depending on the size of the files. VBScript Const sFirstColbata = "Calendar" Set fs0 = Createdbject("Scripting.FileSystenObject") Dim sFilePathi, sFilePath2 ‘If WScript.Arguments.Count = 2 thensFilePath = Wscript.Arguments (0) sFilePath2 = WScript.Arguments(1) Else MsgBox("Please drag and drop two excel files.") Wscript quit End If If fso.FileExists(sFilepath1) = False Then MsgBox "File 1 is missing: " & sFilePath1 Wscript quit End If If fs0.FileExists(sFilePath2) = False Then MsgBox "File 2 is missing: " & sFilePath2 Wscript quit End If Dim sMissingsheets: sMissingsheets Din iDiffcell: iviffcell = @ Dim ADiffRow: iDiFfROW = 0 Din ADiFfCol: iiFFCol = 0 Dim oExcel: Set oExcel = CreateObject("Excel. Application") ofxcel. Visible = True o€xcel.DisplayAlerts = false Set oWorkBook1 = o£xcel.Workbooks.Open(sFilePath1) Set oWorkBook? = oFxcel Workbooks open(sFilePath2) For Each oSheet in oWorkBook1.Worksheets Tf SheetExists(oWorkBook2, oSheet.Name) = False Then if sMissingSheets <> "" Then sMissingSheets = sMissingSheets & ", sMissingSheets = sMissingSheets & oSheet.Name Else oSheet Activate Set oSheet2 = oWlorkBook2.Worksheets(oSheet.Name) Set rs = GetExcelRecordset(oSheet) Set rs2 = GetExcelRecordset (oSheet2) CompareCells oSheet, rs, oSheet2, rs2 CompareCells oSheet2, rs2, oSheet, rs End If Next For Each oSheet in oWorkBook2.Worksheets If SheetExists(oWorkBook1, oSheet.Name) = False Then if sMissingSheets <> "" Then sMissingSheets = sMissingSheets & sMissingSheets = sMissingSheets & oSheet.Name End If Next Dim spiff: sbiff if iDiffcell <> @ Then SDiff = sDiff & iDiffCell & " cell differences.” End If if 4DiffROW <> @ Then if sDiff <> "" Then sDiff = sDiff & SDiff = sDiff & iDIffROW & " row differences.End If if 4DiFFCOl <> @ Then if 4DiffCol <> "" Then sDiff = sDiff &” SDiff = sDiff & iDiffcol & " colunn differences. End If If sMissingSheets <> "" Then Lf sDIff <> "" Then sDEff = sDLfF & SDiff = Diff & "Missing Worksheets: " & sMissingSheets & "." End If Lf sDiff = "" Then MsgBox “Files match" Else MsgBox “Found " & sDiff End If Sub CompareCells(oSheet, rs, oSheet2, rs2) ResetRs rs ResetRs rs2 Dim oColDiff: Set oColDiff = CreateObject (Scripting. Dictionary") Dim col: Set col = GetColDif#(oSheet, oSheet2) Dim iRow, iRow2 While rs.£0F = False Row = rs("RowNumber").Value sFirstCol = rs("c1").value & If sFirstCol <> rs2.Filter & sFirstcol @"'" If rs2.RecordCount = @ Then oSheet Rows (iRow & " ADiffRow = iDiffRow + 1 & iRow).Interior.Color = RGB(219, 255, 2) ElseIf rs2.RecordCount = 1 Then iRow2 = rs2("RowNumber"). Value For iCol = 1 to rs.Fields.Count - 1 icol2 = icol If col.£xists(icol) Then iol2 = col(icol) End If If iCol2 = -1 Then ‘Col not found If oColbiff.Exists(iCol) = False Then oSheet .Columns(iCol).Interior.color oColDiFF(iCol) = True End If RGB(219, 255, 51) ElseIf iCol >= rs.Fields.Count Or iCol2 >= rs2.Fields.Count Then ‘out of range ElseIf rs(icol).Value & "" <> rs2(iCol2).Value &oSheet.Cells(iRow, iCol ).Interior.Color = 65535 iDiffcell = ipiffcell + 1 End If Next End If End If s.MoveNext Wend If oColbiff.count > @ Then ADiffCol = ADIfFCol + oColDifF.Count End If End Sub Sub ResetRs(rs) vs.Filter If rs.Recordcount > @ Then Ps.NoveFinst End If End sub Function GetColDiff(oSheet, oSheet2) Dim oRet: Set oRet = CreateObject("Scripting.Dictionary") Dim oCols: Set oCols = GetExcelColumns(oSheet) Dim oCols2: Set oCols2 = GetExcelColumns(oSheet2) Dim iCol: icol = @ For Each skey In oCols.Keys Col = oCols(skey) Tf oCols2.Exists(skey) Then Tf i€ol <> oCols2(skey) Then oRet(iCol) = oCols2(skey) ‘Col 1 => 2 (column was moved for 1 to 2 End If Else oRet(iCol) = -1 ‘Col not found End If Next Set GetColDiff = oRet End Function Function GetexcelColunns(osheet) Dim oCols: Set oCols = Createdbject("Scripting.Dictionary") Din iHeaderRow: iHeaderRow = 1 If sFirstColbata <> "" Then For i = 1 to 100 If oSheet.Cells(i, 1).Value = sFirstColpata Then iKeaderRow = i -1 Exit For End If Next End If Dim iColCount: icolCount = GetLastcol (sheet) For i¢ol = 1 to iColCountsVal = oShet Cells(iHeaderRow, iCol).Value Tf sVal <> "" Then oCols(sval) = icol End If Next Set GetExcelcolumns = oCols End Function Function GetExcelRecordset (oSheet) Dim icolCount: iColCount = GetLastcol(oSheet) Dim iRowsCount: iRowsCount = GetLastRowWithData(oSheet) Dim rs: Set rs= CreateObject (“ADODB. recordset rs.Fields.Append "RowNunber", 3 ‘adInteger For i¢ol = 1 to iColCount s.Fields.Append " Next: & iCol, 208, -1 ‘adVarchar rs.Open For iRow = 1 to iRowsCount rs.AddNew For iCol = 1 to iColcount c" & iCol) = oSheet.Cells(irow, iCol).Value Next Next Ps.MoveFirst Set GetexcelRecordset = rs End Function Function GetLastRowithData(oSheet) Dim iMaxRow: iMaxRow = oSheet.UsedRange. Rows .Count If iMaxow > 500 Then iMaxRow = oSheet.Cells.Find("*", oSheet.Cells(1, 1), -4163, , 1, 2)-Row End If Dim iRow, iCol For iRow = iMaxRow to 1 Step -1 For iCol = 1 to oSheet.UsedRange.Columns.count If Trim(oSheet.Cells(irow, icol).Value) <> GetLastRowwithbata = iRow Exit Function End If Next Next GetLastRowWithbata End Function Then Function GetLastCol(st) GetLastCol = st.Cells.Find( End Function » st.Cells(1, 1), , 2, 2, 2, False).Colunn Function SheetExists(oWorkBook, sName)on error resume next Dim oSheet: Set oSheet = oWorkBook.Worksheets(sName) If Err.number = @ Then SheetExists = True Else SheetExists = False Err.Clear End If End Function ExcelCompare.vbs compares cells. It is smaller and can be more easily understood. VBScript Set fso = Createdbject("Scripting. FileSystenObject") Dim sFilePath1, sFilePath2 If WScript.Arguments.Count = 2 then sFilePathi = WScript.Arguments(@) sFilePath2 = WScript.Arguments(1) Else MsgBox("Please drag and drop two excel files. Wscript.Quit End Tf If f50.FileExists(sFilePath1) = False Then MsgBox "File 1 is missing: " & sFilePath Wscript.quit End Tf If #s0.FileExists(sFilePath2) = False Then MsgBox "File 2 is missing: " & sFilePath2 Wscript.Quit End If Dim sMissingSheets: sMissingSheets Dim ipiffcount: ipiffcount = @ Dim o€xcel: Set oExcel = CreateObject("Excel Application") ofxcel.Visible = True o€xcel.DisplayAlerts = false Set oWorkBook1 = o£xcel.Workbooks.Open(sFilePath1) Set oWorkBook2 = ofxcel.Workbooks.Open(sFilePath2) For Each oSheet in oWorkBook1.Worksheets If SheetExists(oWorkBook2, oSheet.Name) = False Then if sMissingSheets <> "" Then sMissingSheets = sMissingSheets & ", SMissingSheets = sMissingSheets & oSheet Name Else oSheet Activate Set oSheet2 = oWorkBook2.Worksheets(oSheet .Name) icolCount = GetLastCol (oSheet) iRowsCount = GetLastRowWithData(oSheet) For iRow = 1 to iRowsCount For iCol = 1 to iColCount If oSheet.Cells(iRow, iCol).Value <> oSheet2.cells(iRow, iCol).Value ThenOSheet .Cells(iRow, iCol).Interior.Color = 65535 oSheet2.Cells(iRow, iCol).Interior.Color = 65535 ibiffCount = iDiffCount + 1 End If Next Next End If Next For Each oSheet in oWorkBook2.Worksheets If SheetExists(oWorkBook1, oSheet.Name) = False Then Lf sMissingSheets <> "" Then SMissingSheets = sMissingSheets & SMissingSheets = sMissingSheets & oSheet.Name End If Next If ipiffCount = @ Then MsgBox "Files match” Else MsgBox "Found " & iDiffCount & " differences” End Tf If sMissingSheets <> "" Then MsgBox "Missing Worksheets: " & sMissingSheets End TF Function GetLastRowMithData(oSheet) Dim iMaxRow: iMaxRow = oSheet.UsedRange.Rows.Count If iMaxRow > 588 Then iMaxRow = oSheet.Cells.Find("* End If oSheet.Cells(1, 1), -4163, , 1, 2).Row Dim iRow, icol For iRow = iMaxRow to 1 Step -1 For iCol = 1 to oSheet.UsedRange.Columns .Count If Trim(oSheet.Cells(iRow, iCol).Value) <> GetLastRowWithData = iRow Exit Function End If Next Next GetLastRowhithData = 1 End Function Then Function GetLastCol(st) GetLastCol = st.Cells.Find("*", st.Cells(1, 1), , 2, 2, 2, False).Column End Function Function SheetExists(oWorkBook, sName) on error resume next Dim oSheet: Set oSheet = oWorkBook.Worksheets(sName) If Err.number = @ Then SheetExists = True Else SheetExists = False Err.ClearEnd If End Function History * 18" November, 2020: Initial version © 1% December, 2020: Added ExcelRowCompare.vbs License This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL) Written By Igor Krupitsky Web Developer B United States Igor is a business intelligence consultant working in Tampa, Florida. He has a BS in Finance from University of South Carolina and Masters in Information Management System from University of South Florida, He also has following professional certifications: MCSD, MCDBA, MCAD. Comments and Discussions & 10 messages have been posted for this article Visit https://www.codeproject.com/Tips/5286591/Compare-Two-Excel-Files to post and view comments on this article, or click here to get a print view with messages. Permalink Article Copyright 2020 by Igor Krupitsky Advertise Everything else Copyright © CodeProject, Privacy 1999-2023 Cookies Terms of Use Web01 2.8:2023-05-13:1