?
Solved

VB script to log highlighted changes

Posted on 2015-02-02
5
Medium Priority
?
130 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
5 Comments
 
LVL 18

Accepted Solution

by:
Simon earned 2000 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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
Viewers will learn various types of data validation for different data types in Excel 2013.
Viewers will learn the basics of using filtering and sorting in Excel 2013.

762 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