Solved

VB script to log highlighted changes

Posted on 2015-02-02
5
117 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:
SimonAdept 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:SimonAdept
ID: 40586447
Glad to help, and to see that you worked out how to append instead of overwrite.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Viewers will learn a basic relationship technique in Power Pivot for Excel 2013.
Viewers will learn the basics of the new Quick Analysis feature in Excel 2013.

743 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

12 Experts available now in Live!

Get 1:1 Help Now