VB script to log highlighted changes

I have a vb script in MS Excel 2010 that will compare 2 workbooks and highlight the changes in the new workbook.  I would like to alter the script to also log the changes to an external text file.  Currently it only highlights the cells yellow, bold and a pop up box indicates the total number of differences.

I would like to log the following information:  impacted cell (row and column reference), old value, new value

Below is the script I am using to highlight the changes between workbooks.
My old workbook is:  CSG_Mapping_Template.xlsx
My new workbook is:  CSG_Mapping_Template_new.xlsx
My sheet that I am comparing is "System Info"

Sub compareSystemInfo() 'and highlight the diffrence
    Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim rCount As Long, cCount As Long
    Dim myDiffs As Integer
Set wb1 = Workbooks.Open("C:\Import\CSG_Mapping_Template.xlsm")
Set wb2 = Workbooks.Open("C:\Import\CSG_Mapping_Template_New.xlsm")
    Set sh1 = wb1.Sheets("System Info")
    Set sh2 = wb2.Sheets("System Info")
    rCount = sh1.UsedRange.Rows.Count
    cCount = sh1.UsedRange.Columns.Count
    Dim r As Long, c As Integer
       For r = 1 To rCount
        For c = 1 To cCount
        If Not IsDate(sh2.Cells(r, c)) Then
                If sh1.Cells(r, c) <> sh2.Cells(r, c) Then
                sh2.Cells(r, c).Interior.ColorIndex = 6
                sh2.Cells(r, c).Font.Bold = True
                myDiffs = myDiffs + 1
            End If
            End If
        Next c
    Next r
    Set sh1 = Nothing
    Set sh2 = Nothing
'Display a message box stating the number of differences found
MsgBox myDiffs & " differences found", vbInformation, "System Info Tab"
End Sub
azaunAsked:
Who is Participating?
 
SimonConnect With a Mentor Commented:
Here you go. In this example it write to a file called 'diffs.txt' in the current directory, but you can replace that with any filepath you want. As written it will silently overwrite the file each time the macro is run.

Sub compareSystemInfo() 'and highlight the diffrence
    Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim rCount As Long, cCount As Long
    Dim myDiffs As Integer
    Dim fileNum As Long
    Dim outputFile As String
    
    fileNum = FreeFile 'Get the next free filehandle
    Open "diffs.txt" For Output As #fileNum 'open the file for writing
Set wb1 = Workbooks.Open("C:\Import\CSG_Mapping_Template.xlsm")
Set wb2 = Workbooks.Open("C:\Import\CSG_Mapping_Template_New.xlsm")
    Set sh1 = wb1.Sheets("System Info")
    Set sh2 = wb2.Sheets("System Info")
    rCount = sh1.UsedRange.Rows.Count
    cCount = sh1.UsedRange.Columns.Count
    Dim r As Long, c As Integer
       For r = 1 To rCount
        For c = 1 To cCount
        If Not IsDate(sh2.Cells(r, c)) Then
                If sh1.Cells(r, c) <> sh2.Cells(r, c) Then
                sh2.Cells(r, c).Interior.ColorIndex = 6
                sh2.Cells(r, c).Font.Bold = True
                myDiffs = myDiffs + 1
                Print #fileNum, sh1.Cells(r, c).Address & "," & sh1.Cells(r, c).Value & "," & sh2.Cells(r, c).Value 'write the address, old value, new value to the output file
            End If
            End If
        Next c
    Next r
    Set sh1 = Nothing
    Set sh2 = Nothing
    Close #fileNum 'close the output file.
'Display a message box stating the number of differences found
MsgBox myDiffs & " differences found", vbInformation, "System Info Tab"
End Sub

Open in new window


This is example code. For production I'd suggest error handling to ensure that the output file ALWAYS gets closed.
0
 
azaunAuthor Commented:
Simonadept - that worked perfectly!  I have to run this across multiple tabs, is there a way to append to the existing log instead of creating/overwriting each time?

Thanks,
0
 
azaunAuthor Commented:
Worked perfectly!
0
 
azaunAuthor Commented:
I was able to update the script to append to an existing text file each time - not overwrite.  Solution below.

Sub compareSystemInfo() 'and highlight the diffrence
    Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim rCount As Long, cCount As Long
    Dim myDiffs As Integer
    Dim fileNum As Long
    Dim outputFile As String
    fileNum = FreeFile 'Get the next free filehandle
    Open ("C:\Import\diffs.txt") For Append As #fileNum 'open the file for writing
   
Set wb1 = Workbooks.Open("C:\Import\CSG_Mapping_Template.xlsm")
Set wb2 = Workbooks.Open("C:\Import\CSG_Mapping_Template_New.xlsm")
    Set sh1 = wb1.Sheets("System Info")
    Set sh2 = wb2.Sheets("System Info")
    rCount = sh1.UsedRange.Rows.Count
    cCount = sh1.UsedRange.Columns.Count
    Dim r As Long, c As Integer
       For r = 1 To rCount
        For c = 1 To cCount
        If Not IsDate(sh2.Cells(r, c)) Then
                If sh1.Cells(r, c) <> sh2.Cells(r, c) Then
                sh2.Cells(r, c).Interior.ColorIndex = 6
                sh2.Cells(r, c).Font.Bold = True
                Print #fileNum, "System Info" & "," & sh1.Cells(r, c).Address & "," & sh1.Cells(r, c).Value & "," & sh2.Cells(r, c).Value 'write the address, old value, new value to the output file
                myDiffs = myDiffs + 1
            End If
            End If
        Next c
    Next r
    Set sh1 = Nothing
    Set sh2 = Nothing
    Close #fileNum 'close the output file.
'Display a message box stating the number of differences found
MsgBox myDiffs & " differences found", vbInformation, "System Info Tab"
End Sub
0
 
SimonCommented:
Glad to help, and to see that you worked out how to append instead of overwrite.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.