Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

EE Professionals,

I have a Macro, written by several EE Professionals (and combined) including DMille and others. The code is in This Workbook because it will be used with a number of "Active Sheets". The Macro is designed to add months (Columns) with an entry in AB3, with the formulas that are adjacent (in the cells that are replicated). When the number in AB3, representing the number of months changes, all months beyond that number should be cleared. The problem I am having is it doesn't work now that I have integrated it and I can't find the problem. I've attached a paired down WB with the two affected WS ("Scenario_Template"). Here is the code in the This Workbook that's giving me the problem.

'New code to expand months

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Target.Worksheet.Range("AB3")) Is Nothing Then

Dim NoYears As Long

Dim rngClear As Range

Dim LastCol As Long

Application.EnableEvents = False

LastCol = Cells(4, Columns.Count).End(xlToLeft).Column

Set rngClear = Range("AJ2", Cells(4, Columns.Count)).Resize(6)

rngClear.ClearContents

NoYears = Range("AB3")

If NoYears > 1 Then

With Range("AI2")

.Offset(0, 1).Resize(, NoYears - 1).FormulaR1C1 = "=DATE(YEAR(rc[-1]),MONTH(rc[-1])+1,DAY(rc[-1]))"

.Offset(0, 1).Resize(, NoYears - 1).Value = .Offset(0, 1).Resize(, NoYears - 1).Value

End With

End If

Range("AI3:AI4").Copy Range("AI3:AI4").Resize(, NoYears)

Application.EnableEvents = True

End If

End Sub

Much thanks with this tough troubleshoot.

B.

Workbench-v24.xlsm

I have a Macro, written by several EE Professionals (and combined) including DMille and others. The code is in This Workbook because it will be used with a number of "Active Sheets". The Macro is designed to add months (Columns) with an entry in AB3, with the formulas that are adjacent (in the cells that are replicated). When the number in AB3, representing the number of months changes, all months beyond that number should be cleared. The problem I am having is it doesn't work now that I have integrated it and I can't find the problem. I've attached a paired down WB with the two affected WS ("Scenario_Template"). Here is the code in the This Workbook that's giving me the problem.

'New code to expand months

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Target.Worksheet.Range("AB

Dim NoYears As Long

Dim rngClear As Range

Dim LastCol As Long

Application.EnableEvents = False

LastCol = Cells(4, Columns.Count).End(xlToLef

Set rngClear = Range("AJ2", Cells(4, Columns.Count)).Resize(6)

rngClear.ClearContents

NoYears = Range("AB3")

If NoYears > 1 Then

With Range("AI2")

.Offset(0, 1).Resize(, NoYears - 1).FormulaR1C1 = "=DATE(YEAR(rc[-1]),MONTH(

.Offset(0, 1).Resize(, NoYears - 1).Value = .Offset(0, 1).Resize(, NoYears - 1).Value

End With

End If

Range("AI3:AI4").Copy Range("AI3:AI4").Resize(, NoYears)

Application.EnableEvents = True

End If

End Sub

Much thanks with this tough troubleshoot.

B.

Workbench-v24.xlsm

Dave

Sorry. Here you go. No password.

Workbench-v25.xlsm

Workbench-v25.xlsm

See attached.

Ps - not sure why you didn't use my code - it worked on months or years, lol - and the dateseries was more efficient than formulas, but no biggie.

Dave

Workbench-v25-r1.xlsm

Appreciate it. Here's the challenge. On the Questionaire (a different WS), it copies over the Scenario_Template into different Scenarios (i.e. Scenario1, Scenario2, Scenario3, etc.etc.) Then in each Scenario, you can replicate the Use Case (the section you are fixing) within the Scenario. I'm working on the ROI section and that's where I had the problem you are fixing. I thought it appropriate to put it into the ThisWorkbook since I'll be accessing the code from any Scenario WS.

Also, I'd love to use your code! but make it work for Month's only. The Year option was an attempt to get a Yr. summary and I just thought it added too much complexity.

Thank you,

B.

1. Moved your new routine, changing it from Worksheet_Change() to CheckExpMonths() in the ThisWorkbook() codepage.

2. Added the call to CheckExpMonths at the end of the if statement that has detected a change is being made on *Scenario* sheet.

Here's your revised ThisWorkbook code:

```
Option Explicit
Private Sub Workbook_Open()
'Sheets("Splash").Select
Application.OnTime Now() + TimeSerial(0, 0, 1), "module1.ShowForm"
End Sub
'This starts the code to update the Scenario Sheet calculations
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub 'only works on single data entry
'use the following (code commented) if you want to restrict the sheets that are checked
'if Sh.Name = "this sheet" then
'If Sh.Name <> "other sheet" Then
If Sh.Name Like "*Scenario*" Then 'This identifies the source for input
On Error Resume Next
If Not Intersect(Target, Range("N3")) Is Nothing Then 'checking every sheet, or inside the if on specific sheets
If Err.Number <> 0 Then Exit Sub
Application.EnableEvents = False 'avoid infinite loop because the next line will trigger a change event
ThisWorkbook.Worksheets("Scenario1").Range("R3").Value = Range("N3").Value * Range("Q3") + Range("N10") 'puts the value in to another worksheet - you need to specify the name
Application.EnableEvents = True
End If
On Error GoTo 0
If Not Intersect(Target, Range("M:M")) Is Nothing Then
If Left(Target.Formula, 1) = "=" Then 'its a formula
Application.EnableEvents = False
Range("N" & Target.Row).Formula = Target.Formula
Range("N" & Target.Row).Value = Range("N" & Target.Row).Value
Range("ZZ" & Target.Row).Value = True 'set a flag to note the macro put this value here
Application.EnableEvents = True
End If
End If
If Not Intersect(Target, Range("N:N")) Is Nothing Then 'set flag so we know whether to evaluate the M formula in N column
Application.EnableEvents = False
If Range("N" & Target.Row).Value = vbNullString Then 'user cleared it out, reset the flage
If Left(Range("M" & Target.Row).Formula, 1) = "=" Then 'its a formula!
Range("N" & Target.Row).Formula = Range("M" & Target.Row).Formula
Range("N" & Target.Row).Value = Range("N" & Target.Row).Value
End If
Range("ZZ" & Target.Row).Value = True 'set a flag to note the macro put this value here
Else
Range("ZZ" & Target.Row).Value = False
End If
Application.EnableEvents = True
End If
' If Not Intersect(Target, Range("M:Q")) Is Nothing Then 'if any value changes in the range, update the Result
If Target.Row >= 3 And Not Intersect(Target, Range("M:Q")) Is Nothing Then 'if any value changes in the range, update the Result
Application.EnableEvents = False
'Formula in A1 notation is: =C10*(1+F10)^(VLOOKUP(D10,CA_Calc_Engine!$D$7:$F$15,3,0)*E10)
Range("R" & Target.Row).FormulaR1C1 = _
"=if(RC[-3]=""One Time"",RC[-4],if(RC[-4]=0,0,RC[-4]*(1+RC[-1])^(VLOOKUP(RC[-3],CA_Calc_Engine!R7C6:R15C8,3,0))*RC[-2]))"
'=IF(O5="One Time",N5,IF(N5=0,0,N5*(1+Q5)^(VLOOKUP(O5,CA_Calc_Engine!$F$7:$H$15,3,0))*P5))
' "if(RC[-2]<>0,(RC[-4]*(1+RC[-1])^(VLOOKUP(RC[-3],CA_Calc_Engine!R7C6:R15C8,3,0)*RC[-2]))RC[-2]),RC[-4])"
' "if(RC[-2]="",0,(RC[-4]*(1+RC[-1])^(VLOOKUP(RC[-3],CA_Calc_Engine!R7C6:R15C8,3,0)*RC[-2]))RC[-2]),RC[-4])"
'Range("G" & Target.Row).Value = Range("G" & Target.Row).Value 'if formula is correct, then uncomment this line to just paste the value
Application.EnableEvents = True
End If
Call CheckExpMonths(Target)
End If 'if you are using excluding logic with an if statement, above
End Sub
'New code to expand months
Private Sub CheckExpMonths(ByVal Target As Range)
Dim NoYears As Long
Dim rngClear As Range
Dim LastCol As Long
If Not Intersect(Target, Target.Worksheet.Range("AB3")) Is Nothing Then
Application.EnableEvents = False
LastCol = Cells(4, Columns.Count).End(xlToLeft).Column
Set rngClear = Range("AJ2", Cells(4, Columns.Count)).Resize(6)
rngClear.ClearContents
NoYears = Range("AB3")
If NoYears > 1 Then
With Range("AI2")
.Offset(0, 1).Resize(, NoYears - 1).FormulaR1C1 = "=DATE(YEAR(rc[-1]),MONTH(rc[-1])+1,DAY(rc[-1]))"
.Offset(0, 1).Resize(, NoYears - 1).Value = .Offset(0, 1).Resize(, NoYears - 1).Value
End With
End If
Range("AI3:AI4").Copy Range("AI3:AI4").Resize(, NoYears)
Application.EnableEvents = True
End If
End Sub
Sub ClearWorksheet()
Dim r As Range
For Each r In ActiveSheet.Range("C3:Z5")
'UsedRange
If Not r.Locked Then
r.MergeArea.ClearContents
'r.ClearContents
End If
Next r
End Sub
```

See attached.

Dave

Workbench-v25-r2.xlsm

B.

'This starts the code to update the Scenario Sheet calculations

?

Right?

B.

However, you should be able to...

Just copy the entire ThisWorkbook codepage and then replace what you have in your working workbook.

And you can change out CheckExpMonths() if you want to use the DateSerial approach with no formulas.

Dave

Thanks much! Off integrating it now.

B.

One "error checking" problem. When I go to clear the Time Horizon cell as in terms of a reset, and clear it, I get a macro error. Then the macro won't run until I clear all the way out of Excel and restart Excel.

Any quick fixes?

B.

```
Private Sub CheckExpMonths(ByVal Target As Range)
Dim numPeriods As Long
Dim rngClear As Range
Dim LastCol As Long
If Not Intersect(Target, Range("AB3")) Is Nothing Then
Application.EnableEvents = False
LastCol = Cells(4, Columns.Count).End(xlToLeft).Column
Set rngClear = Range("AJ2", Cells(4, Columns.Count)).Resize(6)
rngClear.ClearContents
numPeriods = Range("AB3")
If numPeriods > 1 Then
With Range("AI2")
.Resize(, numPeriods).DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:=xlMonth, Step:=1, Trend:=False
End With
Range("AI3:AI4").Copy Range("AI3:AI4").Resize(, numPeriods)
End If
Application.EnableEvents = True
End If
End Sub
```

I have another Post out there for addressing the two formulas now that the time horizon is dynamic...

Again, appreciate the help.

B.

Hate to bother you again; however, when you replicate the rows (i.e. click the + User Case button), and then you change the Time Horizons, the new User Cases do not respond accordingly. The original one does but not the new ones. I think it is because it is "hard coded" into the macro. I think it's in these two reference points:

Set rngClear = Range("AJ2", Cells(4, Columns.Count)).Resize(6)

rngClear.ClearContents

numPeriods = Range("AB3")

B.

All Courses

From novice to tech pro — start learning today.

Open in new window

If you prefer this, just change out the subroutine for this one.

Attached,

Dave

Workbench-v25-r3.xlsm