• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 203
  • Last Modified:

Split macro into four parts

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
Seamus2626
Asked:
Seamus2626
  • 6
  • 6
1 Solution
 
mvidasCommented:
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
 
Seamus2626Author Commented:
Hi Matt,

I will try this first thing in the morning when im back in office, many thanks
0
 
mvidasCommented:
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
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!

 
Seamus2626Author Commented:
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
 
Seamus2626Author Commented:
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
 
mvidasCommented:
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
 
Seamus2626Author Commented:
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
 
mvidasCommented:
Why do you have to have 40000x160 records (and more)?
0
 
Seamus2626Author Commented:
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
 
mvidasCommented:
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
 
Seamus2626Author Commented:
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
 
mvidasCommented:
What are the formulas? Maybe they can be improved? Do you need every column?
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

  • 6
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now