Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Troubleshooting Worksheet with Date Expansion

Posted on 2012-03-11
21
Medium Priority
?
292 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 11
  • 10
21 Comments
 
LVL 42

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 42

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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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 42

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 42

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 42

Accepted Solution

by:
dlmille earned 2000 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 42

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
 
LVL 42

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 42

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 42

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 42

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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

722 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