Solved

Troubleshooting Worksheet with Date Expansion

Posted on 2012-03-11
21
241 Views
Last Modified: 2012-03-12
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
0
Comment
Question by:Bright01
  • 11
  • 10
21 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 37707685
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
0
 

Author Comment

by:Bright01
ID: 37707692
Sorry.  Here you go.  No password.
Workbench-v25.xlsm
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37707707
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
0
 

Author Comment

by:Bright01
ID: 37707745
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37707748
ok - let me work it - you want it to work on any sheet that has the word Scenario in it?

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37707759
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
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37707821
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
0
 

Author Comment

by:Bright01
ID: 37708036
Cool!  I'll try to integrate it first thing in the morning....but on the surface.....seems to work very well.

B.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37708038
Excellent!


Dave
0
 

Author Comment

by:Bright01
ID: 37708045
Are the changes in "This Workbook" or do I need to consider other areas (Modules, WSs)?
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 41

Expert Comment

by:dlmille
ID: 37708050
They are just in ThisWorkbook.

Dave
0
 

Author Comment

by:Bright01
ID: 37708061
Got it.  Will let you know first thing in the AM.

B.
0
 

Author Comment

by:Bright01
ID: 37708068
Just to be clear; I should copy the code you changed at"

'This starts the code to update the Scenario Sheet calculations

?  

Right?

B.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37708073
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
0
 

Author Closing Comment

by:Bright01
ID: 37709196
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.
0
 

Author Comment

by:Bright01
ID: 37709307
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37710466
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

0
 

Author Comment

by:Bright01
ID: 37710494
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.
0
 

Author Comment

by:Bright01
ID: 37711874
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37712040
I think you need to ask a new question for this one.

Dave
0
 

Author Comment

by:Bright01
ID: 37712071
Dave,

Posted!  Thanks,

B.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …

705 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

19 Experts available now in Live!

Get 1:1 Help Now