Solved

Split macro into four parts

Posted on 2013-11-20
12
165 Views
Last Modified: 2013-11-22
Hi,

Below is a macro which fills out formula based on the number of entries a user enters. We know that one user will enter 40,000. This is too much for excel to handle and causes it to time out.

When you enter 10,000 it copes down fine.

Is it possible to split the macro, so it does 10,000 then does another 10,000 etc etc to 40,000

Many thanks



Sub PrepTool()

'---------------------------------------------------------------------------'
'                                                                           '
     '
'                                                                           '
'---------------------------------------------------------------------------'

' Macro expands sheet for use with required number of records
' Be aware that many aspects of this macro are hard coded (e.g. the lengths of the lines to be copied down)
' and, as such, can be easily broken if the tool is amended


Dim Records As Long
Dim Selection As Integer
Dim x As Integer ' counter

On Error GoTo Finish

Selection = MsgBox("You are about to be asked how many records you will need in the tool. Be aware that choosing a large number of records will inflate the size of the tool markedly. You should save a new version of the tool before choosing to expand for your records as this cannot be undone.  Choose 'Cancel' to go back and save", vbOKCancel)

If Selection = vbCancel Then Exit Sub

Records = InputBox("How many records are you planning to input?", "Sample", 2)

Application.ScreenUpdating = False


'Turns off auto-calculate
Application.Calculation = xlCalculationManual


For x = 1 To 2

    With Sheets("Input - D" & x)
        .Activate
        .Unprotect
    End With
        Range("B8:DW8").AutoFill Range("B8:DW" & (Records + 7))
    ActiveSheet.Protect
    With Sheets("Calculation - D" & x)
        .Activate
        .Unprotect
    End With
        Range("A14:BJ14").AutoFill Range("A14:BJ" & (Records + 13))
    ActiveSheet.Protect

Next x

    With Sheets("Calculation - variation - D2")
        .Activate
        .Unprotect
    End With
        Range("A12:FD12").AutoFill Range("A12:FD" & (Records + 11))
    ActiveSheet.Protect

    With Sheets("Input - D3")
        .Activate
        .Unprotect
    End With
        Range("B8:DW8").AutoFill Range("B8:DW107")
    ActiveSheet.Protect
   
    With Sheets("Calculation - D3")
        .Activate
        .Unprotect
    End With
        Range("A14:BJ14").AutoFill Range("A14:BJ113")
    ActiveSheet.Protect
   
    With Sheets("Calculation - variation - D3")
        .Activate
        .Unprotect
    End With
        Range("A12:FD12").AutoFill Range("A12:FD111")
    ActiveSheet.Protect


Finish:

Sheets("Instructions for use").Activate

Application.ScreenUpdating = True

MsgBox "Your Tool is now ready for use", vbOKOnly, "Ready"

End Sub
0
Comment
Question by:Seamus2626
  • 6
  • 6
12 Comments
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
Hi Seamus,

Instead of using the AutoFill function, why not just copy the cells?
Also, you don't need to .Activate the sheets if you reference the sheet when selecting the range. Using that logic, since you're performing the same functions to different sheets/ranges, you can use a function to do the work for you and just send it the ranges to fill.
Sub PrepTool()

 ' Macro expands sheet for use with required number of records
 ' Be aware that many aspects of this macro are hard coded (e.g. the lengths of the lines to be copied down)
 ' and, as such, can be easily broken if the tool is amended
 
 Dim Records As Long
 
 On Error GoTo Finish
 
 If MsgBox("You are about to be asked how many records you will need in the tool. Be aware that choosing a " & _
  "large number of records will inflate the size of the tool markedly. You should save a new version of the " & _
  "tool before choosing to expand for your records as this cannot be undone.  Choose 'Cancel' to go back and " & _
  "save", vbOKCancel) = vbCancel Then Exit Sub
 
 Records = InputBox("How many records are you planning to input?", "Sample", 2)
 
 Application.ScreenUpdating = False
 'Turns off auto-calculate
 Application.Calculation = xlCalculationManual
  
 Call fPrepSheets(Sheets("Input - D1").Range("B8:DW" & (Records + 7)))
 Call fPrepSheets(Sheets("Input - D2").Range("B8:DW" & (Records + 7)))
 Call fPrepSheets(Sheets("Input - D3").Range("B8:DW107"))
  
 Call fPrepSheets(Sheets("Calculation - D1").Range("A14:BJ" & (Records + 13)))
 Call fPrepSheets(Sheets("Calculation - D2").Range("A14:BJ" & (Records + 13)))
 Call fPrepSheets(Sheets("Calculation - D3").Range("A14:BJ113"))
 Call fPrepSheets(Sheets("Calculation - variation - D2").Range("A12:FD" & (Records + 11)))
 Call fPrepSheets(Sheets("Calculation - variation - D3").Range("A12:FD111"))
 
Finish:
 
 Sheets("Instructions for use").Activate
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 MsgBox "Your Tool is now ready for use", vbOKOnly, "Ready"

End Sub
Private Function fPrepSheets(vRange As Range) As Boolean
 vRange.Worksheet.Unprotect
 vRange.Rows(1).Copy Destination:=vRange
 vRange.Worksheet.Protect
End Function 

Open in new window

Give it a try, let me know how it goes.
Matt
0
 

Author Comment

by:Seamus2626
Comment Utility
Hi Matt,

I will try this first thing in the morning when im back in office, many thanks
0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
It should work fine. If you're still running into the 'too big' problem, here is the same thing but broken up every 10,000 lines
Sub PrepTool()

 ' Macro expands sheet for use with required number of records
 ' Be aware that many aspects of this macro are hard coded (e.g. the lengths of the lines to be copied down)
 ' and, as such, can be easily broken if the tool is amended
 
 Dim Records As Long, vRecords As Long, x As Long, xr As Long
 
 On Error GoTo Finish
 
 If MsgBox("You are about to be asked how many records you will need in the tool. Be aware that choosing a " & _
  "large number of records will inflate the size of the tool markedly. You should save a new version of the " & _
  "tool before choosing to expand for your records as this cannot be undone.  Choose 'Cancel' to go back and " & _
  "save", vbOKCancel) = vbCancel Then Exit Sub
 
 Records = InputBox("How many records are you planning to input?", "Sample", 2)
 
 Application.ScreenUpdating = False
 'Turns off auto-calculate
 Application.Calculation = xlCalculationManual
  
 Call fPrepSheets(Sheets("Input - D3").Range("B8:DW107"))
 Call fPrepSheets(Sheets("Calculation - D3").Range("A14:BJ113"))
 Call fPrepSheets(Sheets("Calculation - variation - D2").Range("A12:FD" & (Records + 11)))
 Call fPrepSheets(Sheets("Calculation - variation - D3").Range("A12:FD111"))
 
 xr = CLng(Records / 10000)
 For x = 0 To xr
  If x = xr Then
   vRecords = Records - 8
  Else
   vRecords = (x + 1) * 10000
  End If
  Call fPrepSheets(Sheets("Input - D1").Range("B" & (8 + x * 10000) & ":DW" & (Records + 8)))
  Call fPrepSheets(Sheets("Input - D2").Range("B" & (8 + x * 10000) & ":DW" & (Records + 8)))
 Next
 xr = CLng(Records / 10000)
 For x = 0 To xr
  If x = xr Then
   vRecords = Records - 14
  Else
   vRecords = (x + 1) * 10000
  End If
  Call fPrepSheets(Sheets("Calculation - D1").Range("A" & (14 + x * 10000) & ":BJ" & (Records + 14)))
  Call fPrepSheets(Sheets("Calculation - D2").Range("A" & (14 + x * 10000) & ":BJ" & (Records + 14)))
 Next
 
Finish:
 
 Sheets("Instructions for use").Activate
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 MsgBox "Your Tool is now ready for use", vbOKOnly, "Ready"

End Sub
Private Function fPrepSheets(vRange As Range) As Boolean
 vRange.Worksheet.Unprotect
 vRange.Rows(1).Copy Destination:=vRange
 vRange.Worksheet.Protect
End Function

Open in new window


And if for some reason the .copy isn't working the same as .autofill, replace the function with this to use autofill (in either version of the code):
Private Function fPrepSheets(vRange As Range) As Boolean
 vRange.Worksheet.Unprotect
 vRange.Rows(1).AutoFill vRange
 vRange.Worksheet.Protect
End Function

Open in new window

I may not be around in the morning, so hopefully that covers any issues that may arise :)
0
 

Author Comment

by:Seamus2626
Comment Utility
Thanks again Matt,

When i use the second version (splitting into 10k) and use the autofill function, it works for calculation - variation - d3 but it doesnt do anything with sheets
Calculation - D1
Calculation - D2

Do you know why that is so?

Many thanks
Seamus
0
 

Author Comment

by:Seamus2626
Comment Utility
PS i put the autofill function on your first block of code and it went as far as 24k rows in calculation - variation D2, so close!!
0
 
LVL 35

Accepted Solution

by:
mvidas earned 500 total points
Comment Utility
Sorry for not getting back sooner, I had a 13 hour day yesterday and just couldn't make the time.
When i use the second version (splitting into 10k) and use the autofill function, it works for calculation - variation - d3 but it doesnt do anything with sheets
Calculation - D1
Calculation - D2

Do you know why that is so?
I'm not sure, the code looks like it should be working fine. It looks like its starting in A14:BJ14.
Actually, I do see a problem in my code, but it wouldn't cause the macro to skip any sheets. Here is a new version for you, give it a shot when you get a minute:
Sub PrepTool()

 ' Macro expands sheet for use with required number of records
 ' Be aware that many aspects of this macro are hard coded (e.g. the lengths of the lines to be copied down)
 ' and, as such, can be easily broken if the tool is amended
 
 Dim Records As Long, vRecords As Long, x As Long, xr As Long
 
 On Error GoTo Finish
 
 If MsgBox("You are about to be asked how many records you will need in the tool. Be aware that choosing a " & _
  "large number of records will inflate the size of the tool markedly. You should save a new version of the " & _
  "tool before choosing to expand for your records as this cannot be undone.  Choose 'Cancel' to go back and " & _
  "save", vbOKCancel) = vbCancel Then Exit Sub
 
 Records = InputBox("How many records are you planning to input?", "Sample", 2)
 
 Application.ScreenUpdating = False
 'Turns off auto-calculate
 Application.Calculation = xlCalculationManual
  
 Call fPrepSheets(Sheets("Input - D3").Range("B8:DW107"))
 Call fPrepSheets(Sheets("Calculation - D3").Range("A14:BJ113"))
 Call fPrepSheets(Sheets("Calculation - variation - D2").Range("A12:FD" & (Records + 11)))
 Call fPrepSheets(Sheets("Calculation - variation - D3").Range("A12:FD111"))
 
 xr = CLng(Records / 10000)
 For x = 0 To xr
  If x = xr Then
   vRecords = Records - 1
  Else
   vRecords = (x + 1) * 10000
  End If
  Call fPrepSheets(Sheets("Input - D1").Range("B" & (8 + x * 10000) & ":DW" & (vRecords + 8)))
  Call fPrepSheets(Sheets("Input - D2").Range("B" & (8 + x * 10000) & ":DW" & (vRecords + 8)))
  Call fPrepSheets(Sheets("Calculation - D1").Range("A" & (14 + x * 10000) & ":BJ" & (vRecords + 14)))
  Call fPrepSheets(Sheets("Calculation - D2").Range("A" & (14 + x * 10000) & ":BJ" & (vRecords + 14)))
 Next
 
Finish:
 
 Sheets("Instructions for use").Activate
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 MsgBox "Your Tool is now ready for use", vbOKOnly, "Ready"

End Sub
Private Function fPrepSheets(vRange As Range) As Boolean
 vRange.Worksheet.Unprotect
 vRange.Rows(1).AutoFill vRange
 vRange.Worksheet.Protect
End Function

Open in new window

0
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

 

Author Closing Comment

by:Seamus2626
Comment Utility
Hi Matt,

Your code is working fine. The problem here is the the macro is trying to expand 160 columns * 40k rows in one sheet. In another two sheets, its 40k rows by 60 columns of formula.

I think the ss is just crashing from the amount of formula

Would yo uhave any suggestions on this?

Thanks
0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
Why do you have to have 40000x160 records (and more)?
0
 

Author Comment

by:Seamus2626
Comment Utility
Its a legacy workbook ive inherited and it needs to rolled out next week so no time for redevelopment

The formulas feed a load of graphs/ tables etc
0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
Do you actually need the formulas themselves, or just the underlying values? If just the end values, maybe you could have the macro leave only the values to speed up the use a little bit? Otherwise if you can't really change it then you're stuck. Sounds like it might be better to keep the data in a database, in a perfect world :)
0
 

Author Comment

by:Seamus2626
Comment Utility
Ya i need the formulas. It would be great to have it in access but its too late now. Will have to think of some workaround!
0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
What are the formulas? Maybe they can be improved? Do you need every column?
0

Featured Post

Highfive Gives IT Their Time Back

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!

Join & Write a Comment

Suggested Solutions

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

762 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

7 Experts available now in Live!

Get 1:1 Help Now