Created
July 2, 2013 21:49
-
-
Save vaughankg/5913527 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub OnChangeCopyUnderScenario(ByVal Target As Range, trigger_area As String, from_area As String, to_area As String, scenario_cell As String, scenario_value As Integer) | |
| 'Usage: OnChangeCopyUnderScenario(Target, "drivers area", "input area", "output area", "scenario cell", "scenario value") | |
| On Error GoTo ErrorHandler | |
| 'Dim | |
| Dim trigger_range As Range | |
| Set trigger_range = Range(trigger_area) | |
| If Not Application.Intersect(trigger_range, Target) Is Nothing Then | |
| Call CopyUnderScenario(from_area, to_area, scenario_cell, scenario_value) | |
| End If | |
| Exit Sub | |
| ErrorHandler: | |
| MsgBox "This operation has encounterd an error." & vbNewLine & Err.Number & " " & Err.Description | |
| End Sub | |
| Sub CopyUnderScenario(from_area As String, to_area As String, scenario_cell As String, scenario_value As Integer) | |
| '' | |
| ' Change the value of a cell then copy the values of one range into another | |
| '' | |
| On Error GoTo ErrorHandler | |
| 'Dim | |
| Dim from_range As Range | |
| Dim to_range As Range | |
| Dim scenario_cell_range As Range | |
| Set from_range = Range(from_area) | |
| Set to_range = Range(to_area) | |
| Set scenario_cell_range = Range(scenario_cell) | |
| Dim saved_scenario_value | |
| Application.EnableEvents = False | |
| If Not (to_range.Rows.Count = from_range.Rows.Count And to_range.Columns.Count = from_range.Columns.Count) Then | |
| Err.Raise 666, "CopyUnderScenario", "Input area must be the same size as output area. Please check the named ranges" | |
| End If | |
| saved_scenario_value = scenario_cell_range.Value | |
| scenario_cell_range.Value = scenario_value | |
| to_range.Value = from_range.Value | |
| scenario_cell_range.Value = saved_scenario_value | |
| Application.EnableEvents = True | |
| Exit Sub | |
| ErrorHandler: | |
| Application.EnableEvents = True | |
| MsgBox "This operation has encounterd an error." & vbNewLine & Err.Number & " " & Err.Description | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment