[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 333
  • Last Modified:

Insert Columns and Formulas - Taking a long time to complete

Hello Experts,

I have the following attached code. It works great apart from the time it takes to complete. Literally takes 1 second to insert the formulas below. Note a problem, but when you have 5 or 6 sheets in the array, each with 2,000 lines, it adds up. Is there anything I can do to solve this?

Regards

LK
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    
    sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")).Select
    sheets("Sheet_1").Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    For Each ws In sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5"))
        ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For x = 10 To lstRow
            ws.Cells(x, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(x, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
        Next x
        Columns("B:B").Select
        Selection.NumberFormat = "dd/mm/yyyy;@"
        Columns("C:C").Select
        Selection.NumberFormat = "h:mm;@"
    Next ws
    
End Sub

Open in new window

0
lkirke
Asked:
lkirke
  • 11
  • 5
  • 4
2 Solutions
 
dlmilleCommented:
I'd try turning calculation to manual, and perhaps screenupdating to false.  There's no need to make cell selections or activate the sheets - rather just reference and DO.  HEre's modified code for you to try:

Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    
    Application.Calculation = xlCalculationManual
    
    Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")).Select
    'Sheets("Sheet_1").Activate

    'Columns("B:C").Select
    Sheets("Sheet_1").Columns("B:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    For Each ws In Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5"))
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For x = 10 To lstRow
            ws.Cells(x, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(x, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
        Next x
        'Columns("B:B").Select
        'Selection.NumberFormat = "dd/mm/yyyy;@"
        'Columns("C:C").Select
        'Selection.NumberFormat = "h:mm;@"
        
        ws.Columns("B:B").NumberFormat = "dd/mm/yyyy;@"
        ws.Columns("C:C").NumberFormat = "h:mm;@"
        
    Next ws
    
    Application.Calculation = xlCalculationAutomatic
    
    
End Sub

Open in new window


Enjoy!

Dave
0
 
dlmilleCommented:
Also, formatting the entire column could be chewing up resources...

Change:

        ws.Columns("B:B").NumberFormat = "dd/mm/yyyy;@"
        ws.Columns("C:C").NumberFormat = "h:mm;@"

to:

        ws.Columns("B1:B" & lstRow).NumberFormat = "dd/mm/yyyy;@"
        ws.Columns("C1:C" & lstRow).NumberFormat = "h:mm;@"

Dave
0
 
lkirkeAuthor Commented:
Great Dave. Awesome stuff. First option did the trick. Only thing is that the sheets remain grouped. How can I ungroup them?
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!

 
Chris BottomleyCommented:
Looks like you have your solution but this is my attempt ... remove the iteration on the row with a copy and stop selecting the sheets.  Oh and I set the sheets collection in one place to make it easier to modify.

Chris
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    Dim arrSheets() As Variant
    Dim strWS As Variant
    
    arrSheets = Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")
    Sheets(arrSheets(0)).Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    For Each strWS In arrSheets
        Set ws = Sheets(strWS)
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'        For x = 10 To lstRow
            ws.Cells(10, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(10, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
            ws.Range(ws.Cells(10, 2), ws.Cells(10, 3)).AutoFill Destination:=Range(ws.Cells(10, 2), ws.Cells(lstRow, 3)), Type:=xlFillDefault
'        Next x
        Columns("B:B").NumberFormat = "dd/mm/yyyy;@"
        Columns("C:C").NumberFormat = "h:mm;@"
    Next
    
End Sub

Open in new window

0
 
lkirkeAuthor Commented:
Correction Dave. Just noticed it is only performing the insert of columns and formulas for Sheet_1. Not the remaining sheets.

Regards

LK
0
 
Chris BottomleyCommented:
Missed a bit on the formatting which used the selected sheet! ... since i'm not selecting the sheet it wouldn't work correctly without the correction.

Chris
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    Dim arrSheets() As Variant
    Dim strWS As Variant
    
    arrSheets = Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")
    Sheets(arrSheets(0)).Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    For Each strWS In arrSheets
        Set ws = Sheets(strWS)
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'        For x = 10 To lstRow
            ws.Cells(10, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(10, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
            ws.Range(ws.Cells(10, 2), ws.Cells(10, 3)).AutoFill Destination:=Range(ws.Cells(10, 2), ws.Cells(lstRow, 3)), Type:=xlFillDefault
'        Next x
        ws.Columns("B:B").NumberFormat = "dd/mm/yyyy;@"
        ws.Columns("C:C").NumberFormat = "h:mm;@"
    Next
    
End Sub

Open in new window

0
 
dlmilleCommented:
Sorry - I didn't see the posts.

Here's the code, deselecting the original group of sheets, before further processing, and backpedalling to your code on the first step...

No other enhancements - fixing what I submitted, as I'd be one-upping Chris, lol

The key thing to remember, is you almost never need to select cells on a sheet, or select sheets, unless there's a specific need.  Just create your reference and do functions with those references...

Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    
    Application.Calculation = xlCalculationManual
    
    Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")).Select
    Sheets("Sheet_1").Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    
    For Each ws In Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5"))
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For x = 10 To lstRow
            ws.Cells(x, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(x, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
        Next x
        'Columns("B:B").Select
        'Selection.NumberFormat = "dd/mm/yyyy;@"
        'Columns("C:C").Select
        'Selection.NumberFormat = "h:mm;@"
        
        ws.Columns("B:B").NumberFormat = "dd/mm/yyyy;@"
        ws.Columns("C:C").NumberFormat = "h:mm;@"
        
    Next ws
    
    Application.Calculation = xlCalculationAutomatic
    
    
End Sub

Open in new window


Dave
0
 
dlmilleCommented:
Whoops - with the "fix" on the lstRow reference for numberformat - assuming you only want to format where you're putting the formulas, could save processing time...


Dave
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    
    Application.Calculation = xlCalculationManual
    
    Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")).Select
    Sheets("Sheet_1").Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    
    For Each ws In Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5"))
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For x = 10 To lstRow
            ws.Cells(x, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(x, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
        Next x
        'Columns("B:B").Select
        'Selection.NumberFormat = "dd/mm/yyyy;@"
        'Columns("C:C").Select
        'Selection.NumberFormat = "h:mm;@"
        
        ws.Columns("B1:B" & lstRow).NumberFormat = "dd/mm/yyyy;@"
        ws.Columns("C1:C" & lstRow).NumberFormat = "h:mm;@"
        
    Next ws
    
    Application.Calculation = xlCalculationAutomatic
    
    
End Sub

Open in new window

0
 
lkirkeAuthor Commented:
Hello Chris. Thank you for the reply. :) Attempted your solution too. However, it is not insert columns and formulas other than Sheet_1, rather just the formulas themselves.
0
 
dlmilleCommented:
@Chris - the autofill add is a good one.  Or a range.resize function would work...  nice.

Dave
0
 
lkirkeAuthor Commented:
Great, Dave. Thank you again. However, trapping on:

ws.Columns("B1:B" & lstRow).NumberFormat = "dd/mm/yyyy;@"
ws.Columns("C1:C" & lstRow).NumberFormat = "h:mm;@"
0
 
dlmilleCommented:
OUCH!  It should be RANGE, not columns - heck - columns need column references as you had...

This works - I should have tested that last, lol!

 
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    
    Application.Calculation = xlCalculationManual
    
    Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")).Select
    Sheets("Sheet_1").Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    
    For Each ws In Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5"))
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For x = 10 To lstRow
            ws.Cells(x, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(x, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
        Next x
        'Columns("B:B").Select
        'Selection.NumberFormat = "dd/mm/yyyy;@"
        'Columns("C:C").Select
        'Selection.NumberFormat = "h:mm;@"
        
        ws.Range("B1:B" & lstRow).NumberFormat = "dd/mm/yyyy;@"
        ws.Range("C1:C" & lstRow).NumberFormat = "h:mm;@"
        
    Next ws
    
    Application.Calculation = xlCalculationAutomatic
    
    
End Sub

Open in new window


Dave
0
 
Chris BottomleyCommented:
?

You were only inserting columns on teh first sheet originally but I did find another bug re the destination for paste.

Chris
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    Dim arrSheets() As Variant
    Dim strWS As Variant
    
    arrSheets = Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")
    Sheets(arrSheets(0)).Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    For Each strWS In arrSheets
        Set ws = Sheets(strWS)
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'        For x = 10 To lstRow
            ws.Cells(10, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(10, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
            ws.Range(ws.Cells(10, 2), ws.Cells(10, 3)).AutoFill Destination:=ws.Range(ws.Cells(10, 2), ws.Cells(lstRow, 3)), Type:=xlFillDefault
'        Next x
        ws.Columns("B:B").NumberFormat = "dd/mm/yyyy;@"
        ws.Columns("C:C").NumberFormat = "h:mm;@"
    Next
    
End Sub

Open in new window

0
 
dlmilleCommented:
Actually, the ACTIVATE command doesn't ungroup the sheets.  So the column insert of B:C works for all sheets

Dave
0
 
dlmilleCommented:
So... This code finishes and ungroups, centering focus on Sheet_1...

see the addition of Sheets("Sheet_1").Select at the end.

Could probably be before the loop, as the loop is focused on WS only, so won't affect any grouped sheets...

Dave
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    
    Application.Calculation = xlCalculationManual
    
    Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")).Select
    Sheets("Sheet_1").Activate

    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    
    For Each ws In Sheets(Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5"))
        'ws.Select
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For x = 10 To lstRow
            ws.Cells(x, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(x, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
        Next x
        'Columns("B:B").Select
        'Selection.NumberFormat = "dd/mm/yyyy;@"
        'Columns("C:C").Select
        'Selection.NumberFormat = "h:mm;@"
        
        ws.Range("B1:B" & lstRow).NumberFormat = "dd/mm/yyyy;@"
        ws.Range("C1:C" & lstRow).NumberFormat = "h:mm;@"
        
    Next ws
    
    Sheets("Sheet_1").Select
    
    Application.Calculation = xlCalculationAutomatic
    
    
End Sub

Open in new window

0
 
Chris BottomleyCommented:
Intersting!
Have never treated sheets as an array in that way ...!  MAde the relevant change ... with apologies ... and thanks!

Chris
Sub InsertCols_Formulas()
    Dim ws As Worksheet
    Dim lstRow As Long
    Dim x As Long
    Dim arrSheets() As Variant
    Dim strWS As Variant
    
    arrSheets = Array("Sheet_1", "Sheet_2", "Sheet_3", "Sheet_4", "Sheet_5")
    Sheets(arrSheets(0)).Activate
    
    For Each strWS In arrSheets
        Set ws = Sheets(strWS)
        ws.Columns("B:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        lstRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'        For x = 10 To lstRow
            ws.Cells(10, 2).FormulaR1C1 = "=IF(ISERROR(INT(RC[-1])),"""",INT(RC[-1]))"
            ws.Cells(10, 3).FormulaR1C1 = "=IF(ISERROR(MOD(RC[-2],1)),"""",MOD(RC[-2],1))"
            ws.Range(ws.Cells(10, 2), ws.Cells(10, 3)).AutoFill Destination:=Range(ws.Cells(10, 2), ws.Cells(lstRow, 3)), Type:=xlFillDefault
'        Next x
        Columns("B:B").NumberFormat = "dd/mm/yyyy;@"
        Columns("C:C").NumberFormat = "h:mm;@"
    Next
    
End Sub

Open in new window

0
 
dlmilleCommented:
@chris - doing the insert in one command for all sheets should be more expedient than one sheet at a time.

Dave
0
 
dlmilleCommented:
Also, your numberformat is coding on the same selection of sheets, instead of ws.columns()...

While I'm at it, if you're formatting the entire columns (rather than just to lstRow), then those 2 commands could come out of the loop, altogether, in both our submittals (mine without the ws. reference prefix, in that case...

Dave
0
 
dlmilleCommented:
But... Formatting an entire column does consume resources, so I'd leave mine alone if you're getting the speed you want, already.  While may be a couple more cycles, it only has to store cell formatting for much less cells...

Dave
0
 
lkirkeAuthor Commented:
Great. Thank you so much guys. All works now. Really appreciate the quick and informative responses from both.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 11
  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now