VBA learner ITG
Active Member
- Joined
- Apr 18, 2017
- Messages
- 272
- Office Version
- 365
- Platform
- Windows
- MacOS
Good morning all,
I hope you are having a great day. I hope you can help as I am now stuck on the code as I have tried numerous iterations and I can seem to resolve the "Compile Error" message on file dialog object.
I am sure I am missing something, but I can't see the forrest through the trees.
Any advice appreciated.
I hope you are having a great day. I hope you can help as I am now stuck on the code as I have tried numerous iterations and I can seem to resolve the "Compile Error" message on file dialog object.
I am sure I am missing something, but I can't see the forrest through the trees.
Any advice appreciated.
VBA Code:
Sub CompareWorkbooksAndHighlightChangesV4()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cell1 As Range, cell2 As Range
Dim changes As Worksheet
Dim lastRow As Long
Dim file1Path As String, file2Path As String
' Create a file dialog object
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
' Set the filter to all files
dlg.Filter = "*.xlsx"
' Show the file dialog box
dlg.Show
' If the user selected a file, get the path
If dlg.SelectedItems.Count > 0 Then
file1Path = dlg.SelectedItems(1)
End If
' If the user did not select a file, exit the sub
If file1Path = vbNullString Then Exit Sub
' Prompt the user to select the second workbook
dlg.Filter = "*.xlsx"
dlg.Show
' If the user selected a file, get the path
If dlg.SelectedItems.Count > 0 Then
file2Path = dlg.SelectedItems(1)
End If
' If the user did not select a file, exit the sub
If file2Path = vbNullString Then Exit Sub
' Set the first workbook and worksheet
Set wb1 = Workbooks.Open(file1Path)
Set ws1 = wb1.Sheets("Sheet1") ' Update the sheet name if necessary
' Set the second workbook and worksheet
Set wb2 = Workbooks.Open(file2Path)
Set ws2 = wb2.Sheets("Sheet1") ' Update the sheet name if necessary
' Create a new worksheet to store the list of changes
Set changes = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
changes.Name = "Changes"
' Set headers in the changes worksheet
changes.Cells(1, 1).Value = "Worksheet"
changes.Cells(1, 2).Value = "Cell Address"
changes.Cells(1, 3).Value = "Value in Workbook 1"
changes.Cells(1, 4).Value = "Value in Workbook 2"
' Loop through each cell in the first worksheet and compare with the second worksheet
lastRow = 2 ' Start from row 2 in the changes worksheet
For Each cell1 In ws1.UsedRange
Set cell2 = ws2.Range(cell1.Address)
If cell1.Value <> cell2.Value Then
cell2.Interior.ColorIndex = 3 ' Highlight in red color
' Add the change details to the changes worksheet
changes.Cells(lastRow, 1).Value = ws1.Name ' Worksheet name
changes.Cells(lastRow, 2).Value = cell1.Address ' Cell address
changes.Cells(lastRow, 3).Value = cell1.Value ' Value in Workbook 1
changes.Cells(lastRow, 4).Value = cell2.Value ' Value in Workbook 2
lastRow = lastRow + 1
End If
Next cell1
' Save and close the workbooks
wb2.Save
wb2.Close
wb1.Close
End Sub