Solved

VB script to log highlighted changes

Posted on 2015-02-02
5
119 Views
Last Modified: 2016-02-11
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
0
Comment
Question by:azaun
  • 3
  • 2
5 Comments
 
LVL 18

Accepted Solution

by:
Simon earned 500 total points
ID: 40584949
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
 

Author Comment

by:azaun
ID: 40586329
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
 

Author Closing Comment

by:azaun
ID: 40586343
Worked perfectly!
0
 

Author Comment

by:azaun
ID: 40586415
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
 
LVL 18

Expert Comment

by:Simon
ID: 40586447
Glad to help, and to see that you worked out how to append instead of overwrite.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Modern/Metro styled message box and input box that directly can replace MsgBox() and InputBox()in Microsoft Access 2013 and later. Also included is a preconfigured error box to be used in error handling.
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Viewers will learn how to share Excel data with others from desktop Excel, as well as Excel Online via OneDrive, and embed an Excel file on a website.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now