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

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

# 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
0
lkirke
• 11
• 5
• 4
2 Solutions

Commented:
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

Enjoy!

Dave
0

Commented:
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

Author Commented:
Great Dave. Awesome stuff. First option did the trick. Only thing is that the sheets remain grouped. How can I ungroup them?
0

Commented:
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
0

Author 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

Commented:
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
0

Commented:
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

Dave
0

Commented:
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
0

Author 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

Commented:
@Chris - the autofill add is a good one.  Or a range.resize function would work...  nice.

Dave
0

Author 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

Commented:
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

Dave
0

Commented:
?

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
0

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

Dave
0

Commented:
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
0

Commented:
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
0

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

Dave
0

Commented:
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

Commented:
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

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

## Featured Post

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