Zaj
Zaj

Reputation:

Highlight changes in Excel

I send a spreadsheet to have information updated and then sent back to me.

I put validation and lock the cells to force users to input accurate information. I use VBA to disable the workaround of cut copy and paste functions. Additionally I inserted a VBA function to force users to open the Excel file in Macros.

I'm trying to track the changes so I know what was updated when I recieve the sheet back. I get an error when someone saves the document and randomly it will lock me out of the document completely.

How can I highlight changes through VBA instead of through Excel's share/track changes option?

ThisWorkbook:

Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ToggleCutCopyAndPaste(True)

     'Turn off events to prevent unwanted loops
    Application.EnableEvents = False

     'Evaluate if workbook is saved and emulate default propmts
    With ThisWorkbook
        If Not .Saved Then
            Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
                vbYesNoCancel + vbExclamation)
            Case Is = vbYes
                 'Call customized save routine
                Call CustomSave
            Case Is = vbNo
                 'Do not save
            Case Is = vbCancel
                 'Set up procedure to cancel close
                Cancel = True
            End Select
        End If

         'If Cancel was clicked, turn events back on and cancel close,
         'otherwise close the workbook without saving further changes
        If Not Cancel = True Then
            .Saved = True
            Application.EnableEvents = True
            .Close savechanges:=False
        Else
            Application.EnableEvents = True
        End If
    End With

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     'Turn off events to prevent unwanted loops
    Application.EnableEvents = False

     'Call customized save routine and set workbook's saved property to true
     '(To cancel regular saving)
    Call CustomSave(SaveAsUI)
    Cancel = True

     'Turn events back on an set saved property to true
    Application.EnableEvents = True
    ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
    Call ToggleCutCopyAndPaste(False)

     'Unhide all worksheets
    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
    Dim ws As Worksheet, aWs As Worksheet, newFname As String
     'Turn off screen flashing
    Application.ScreenUpdating = False

     'Record active worksheet
    Set aWs = ActiveSheet

     'Hide all sheets
    Call HideAllSheets

     'Save workbook directly or prompt for saveas filename
    If SaveAs = True Then
        newFname = Application.GetSaveAsFilename( _
        fileFilter:="Excel Files (*.xls), *.xls")
        If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
    Else
        ThisWorkbook.Save
    End If

     'Restore file to where user was
    Call ShowAllSheets
    aWs.Activate

     'Restore screen updates
    Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
     'Hide all worksheets except the macro welcome page
    Dim ws As Worksheet

    Worksheets(WelcomePage).Visible = xlSheetVisible

    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
    Next ws

    Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
     'Show all worksheets except the macro welcome page

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
    Next ws

    Worksheets(WelcomePage).Visible = xlSheetVeryHidden

End Sub

Private Sub Workbook_Activate()
    Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_Deactivate()
    Call ToggleCutCopyAndPaste(True)
End Sub

In a Module:

Option Explicit

Sub ToggleCutCopyAndPaste(Allow As Boolean)
     'Activate/deactivate cut, copy, paste and pastespecial menu items
    Call EnableMenuItem(21, Allow) ' cut
    Call EnableMenuItem(19, Allow) ' copy
    Call EnableMenuItem(22, Allow) ' paste
    Call EnableMenuItem(755, Allow) ' pastespecial

     'Activate/deactivate drag and drop ability
    Application.CellDragAndDrop = Allow

     'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
    With Application
        Select Case Allow
        Case Is = False
            .OnKey "^c", "CutCopyPasteDisabled"
            .OnKey "^v", "CutCopyPasteDisabled"
            .OnKey "^x", "CutCopyPasteDisabled"
            .OnKey "+{DEL}", "CutCopyPasteDisabled"
            .OnKey "^{INSERT}", "CutCopyPasteDisabled"
        Case Is = True
            .OnKey "^c"
            .OnKey "^v"
            .OnKey "^x"
            .OnKey "+{DEL}"
            .OnKey "^{INSERT}"
        End Select
    End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
     'Activate/Deactivate specific menu item
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub

Sub CutCopyPasteDisabled()
     'Inform user that the functions have been disabled
    MsgBox " Cutting, copying and pasting have been disabled in this workbook.  Please hard key in data.  "
End Sub

Upvotes: 1

Views: 6958

Answers (3)

eriklind
eriklind

Reputation: 31

When you need to track and compare changes, there is an easy way without macros at all: try the Version Control add-in for Excel.

You can compare your original spreadsheet with the versions received from other users. Ideally they should also have the add-in installed, but not necessarily.

If you want to keep track of changes in your macro modules, then this Version Control for VBA macros is a lifesaver.

Upvotes: 0

user188188
user188188

Reputation:

Why don't you check up Ozgrid.com:

http://www.ozgrid.com/VBA/track-changes.htm

You can directly implement the code easily and also add several features like highlighting the changed cells, etc. in color.

Upvotes: 0

user188818
user188818

Reputation:

I modified your module slightly as shown below and called the function in 'Workbook_Open' and 'Workbook_Beforeclose' sections of 'This Workbook'. In the former the function argument was False, while in the latter the argument was True. It works well. You would also do well to refer to Yogesh's code, which is more comprehensive. The URL for that is: http://ygblogs.blogspot.com/2009/04/macros-in-excel-disable-cut-copy-paste.html

Insert the following into a module:

Option Explicit
Dim Allow As Boolean, ctlId As Integer, Enabled As Boolean

Function ToggleCutCopyAndPaste(Allow As Boolean)

    'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
    With Application
        Select Case Allow
            Case False
                .OnKey "^c", "CutCopyPasteDisabled"
                .OnKey "^v", "CutCopyPasteDisabled"
                .OnKey "^x", "CutCopyPasteDisabled"
                .OnKey "+{DEL}", "CutCopyPasteDisabled"
                .OnKey "^{INSERT}", "CutCopyPasteDisabled"           
            Case True
                .OnKey "^c"
                .OnKey "^v"
                .OnKey "^x"
                .OnKey "+{DEL}"
                .OnKey "^{INSERT}"
        End Select
        .CutCopyMode = Allow
        .CellDragAndDrop = Allow
    End With

    'Activate/Deactivate specific menu item
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl, i As Integer

    For i = 1 To 4
        If i = 1 Then ctlId = 21
        If i = 2 Then ctlId = 19
        If i = 3 Then ctlId = 22
        If i = 4 Then ctlId = 755        

        For Each cBar In Application.CommandBars
            If cBar.Name <> "Clipboard" Then
                Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
                If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Allow
            End If
        Next
    Next i    
End Function

Insert the following in the ThisWorkbook section of the VBA editor:

Private Sub Workbook_BeforeClose(Cancel As Boolean)    
    ToggleCutCopyAndPaste (True)   
End Sub

Private Sub Workbook_Open()    
    ToggleCutCopyAndPaste (False)    
End Sub

Upvotes: 1

Related Questions