Solved

Split macro into four parts

Posted on 2013-11-20
12
175 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
ID: 39663478
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
ID: 39663498
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
ID: 39663530
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
ID: 39665271
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
ID: 39665275
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
ID: 39668816
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Closing Comment

by:Seamus2626
ID: 39668880
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
ID: 39668940
Why do you have to have 40000x160 records (and more)?
0
 

Author Comment

by:Seamus2626
ID: 39668949
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
ID: 39668970
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
ID: 39669121
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
ID: 39669157
What are the formulas? Maybe they can be improved? Do you need every column?
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
time format showing wrong 12 50
Hiding column macro 10 28
Copy all Sheet1-Sheets into a newly created workbook using VBA 8 33
Excel Copy Macro down foe each row 4 18
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 …
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
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.

911 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

17 Experts available now in Live!

Get 1:1 Help Now