Troubleshooting Worksheet with Date Expansion

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
Bright01Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dlmilleCommented:
You need to unprotect your VBA project or something.  I don't see any code and get a compile error in hidden module userform, etc.

Dave
Bright01Author Commented:
Sorry.  Here you go.  No password.
Workbench-v25.xlsm
dlmilleCommented:
Bright - move that new code to the Scenario_Change worksheet.  You only want to run it there, correct?

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
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

Bright01Author Commented:
Dave,

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.
dlmilleCommented:
ok - let me work it - you want it to work on any sheet that has the word Scenario in it?

Dave
dlmilleCommented:
I've now modified your code as follows:

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

Open in new window


See attached.

Dave
Workbench-v25-r2.xlsm
dlmilleCommented:
And, just for fun, here it is using the dateseries approach:
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
        End If
    
        Range("AI3:AI4").Copy Range("AI3:AI4").Resize(, numPeriods)
        
        Application.EnableEvents = True
    End If
        
End Sub

Open in new window


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

Attached,

Dave
Workbench-v25-r3.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bright01Author Commented:
Cool!  I'll try to integrate it first thing in the morning....but on the surface.....seems to work very well.

B.
dlmilleCommented:
Excellent!


Dave
Bright01Author Commented:
Are the changes in "This Workbook" or do I need to consider other areas (Modules, WSs)?
dlmilleCommented:
They are just in ThisWorkbook.

Dave
Bright01Author Commented:
Got it.  Will let you know first thing in the AM.

B.
Bright01Author Commented:
Just to be clear; I should copy the code you changed at"

'This starts the code to update the Scenario Sheet calculations

?  

Right?

B.
dlmilleCommented:
I think the answer is YES.

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
Bright01Author Commented:
Wow..... I love not having to use the formulas!  You are "The Man" when it comes to complex macros, troubleshooting and all around VBA work.

Thanks much!  Off integrating it now.

B.
Bright01Author Commented:
Dave,

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.
dlmilleCommented:
Yes

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

Open in new window

Bright01Author Commented:
Thanks Dave!

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

Again, appreciate the help.

B.
Bright01Author Commented:
Dave,

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.
dlmilleCommented:
I think you need to ask a new question for this one.

Dave
Bright01Author Commented:
Dave,

Posted!  Thanks,

B.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.