Serious slow performance when inserting a column in Excel 2016 - excel

In Excel 2007 there was no issue but when I hit the below line in Excel 2016, it now takes over a minute each time. There are only 300 rows in the column. All I want to do is cut a column and paste it next to another column.
Selection.Insert Shift:=xlToRight
Sample code is as follows, but I have 30 odd of these so it is taking half an hour.
Columns("E:E").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Any ideas why?

Do you have formulas and maybe even external references? Then please try this:
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ActiveWorkbook.UpdateRemoteReferences = False
Application.Calculation = xlManual
ActiveSheet.Columns("E:E").Cut
ActiveSheet.Columns("C:C").Insert Shift:=xlToRight
ActiveWorkbook.UpdateLinks = xlUpdateLinksAlways
ActiveWorkbook.UpdateRemoteReferences = True
Application.Calculation = xlCalculationAutomatic
' If it's faster, then uncomment following line additionally
' Application.CalculateFull

I had to deal with an Excel xlsx file generated by a Payroll system. Not sure what is causing the slowness on column insert. Inserting a column into a 88,000 row file takes about 25 seconds.
I discovered that if I copy the entire worksheet to a new sheet as values and number formats, the insert column step will run almost instantly. The copy entire worksheet portion takes just 3 seconds! There are no formulas in the file nor conditional formatting.
This is the logic I used:
' Copy source worksheet
Dim rng As Range
Set rng = Worksheets("Sheet1").Cells
rng.Copy ' note that wks.Cells.Copy is very slow
' add new worksheet
Dim newWks As Worksheet
Set newWks = Sheets.Add(After:=ActiveSheet)
newWks.Name = "Values Only"
' paste values and number format into new worksheet
newWks.Range("A1").Select
' xlPasteValues is fast too
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' if I also include a xlPasteFormats then the insert column will become very slow once again
' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' now the column insert is blazingly fast!
newWks.Columns(14).Insert
newWks.Cells(1, 14).Interior.ColorIndex = 35
' etc.

Related

VBA loop to copy & paste range of specific columns to another workbook multiple times

I am trying to figure out the quickest Loop method to copy a range of columns ("A16:J1338") from a source workbook, to a specific column (C1) of a specific workbook, 10 times. I would like to that macro to paste the data below the last available blank cell (under COL C)
Here's my code;
Sub copy_Loop()
Dim LastRow As Long
Range("A16:J1338").Select
Selection.Copy
Workbooks.Open "C:\Users\Manzurfa\Desktop\1. Forecast Amalgamation.xlsx"
Range("C1").Select
ActiveSheet.Paste
Windows("Merrell CA Forecast Template - Alain Travers.xlsm").Activate
Range("K18:O1338").Select
Selection.Copy
Windows("1. Forecast Amalgamation.xlsx").Activate
Range("K3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Merrell CA Forecast Template - Alain Travers.xlsm").Activate
Range("A16:J1338").Select
Selection.Copy
Windows("1. Forecast Amalgamation.xlsx").Activate
Range("B1").Select
Selection.End(xlDown).Select
ActivCell.Offset(0, 1).Select
Selection.End(xlUp).Select
ActivCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveWorkbook.Save
End Sub
The columns ("A16:J1338") have blank rows in between and I would like the macro to overlook the blanks and loop the copy-paste under the last available blank cell.
I would be very grateful for any help on this.
You have FAR too many .Select commands, you can tell excel where to write data without them. In addition you need to set the workbooks and worksheets as variables, given that there names are incredibly long, tidying up things.
Then you can get rid of the selections with a basic
wsTo.Range("B1").Resize(1, Range.Columns.Count).value = wsFr.Range("A16:J1338").value
This is just conceptual, you would need to create your range, worksheet, and workbook variables. Also turning off calculations and screen updating will go a long way.
I would reference https://www.youtube.com/watch?v=GCSF5tq7pZ0 as an all in one package for speeding up your macros, big or small.

Macro to repeat itself on the next rown down

I have this macro which works ok on the first row, but once it has completed I want it to run again on the next row down and paste the result on the next row down on the "results" sheet and continue the process through the whole document until it reaches the last record - (there are approx. 5300 records in my spreadsheet)
Sub Macro2()
' Macro2 Macro
Range("A2:BW2").Select
Selection.Copy
Sheets("Lookup").Select
Range("F3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F3:V3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Result").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
So basically I am copying the first row of data on sheet named "amps_job_history", it them pastes this data into a sheet called "lookup", once the data is pasted there a formula does a calculation that marries the data up with data from another worksheet. I then want to copy the original data plus the extra 3 columns that have been connected to the data with the formulas and the paste it into the sheet called "result". I then want it to go back to the first sheet "amps_job_hisotry" move down to the next row of data and repeat the process and when it pastes the data into the "result" page it need to past on the next row down and so on and so on until it reaches the last record.
I think this loop is what you are looking for.
Sub Macro2()
' Macro2 Macro
Dim rw As Long
With Worksheets("amps_job_history")
For rw = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
With Intersect(.Range("A:BW"), .Rows(rw))
Worksheets("Lookup").Range("F3").Resize(.Rows.Count, .Columns.Count) = .Value
End With
With Worksheets("Lookup")
With .Range("F3:V3")
Worksheets("Result").Range("A1").Offset(rw - 1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
Next rw
End With
End Sub
The rows from the source data in the amps_job_history and the destination Result worksheet are shifted down one more row on each loop. The transitional F3:V3 range in the Lookup worksheet remains the same through out.
I've use direct value transfer rather than copy, paste special, values and the With ... End With statement provide explicit parent worksheet referencing without the use of the Range .Select or Range .Activate methods.

Paste in new sheet after applying filter pastes nothing

I'm trying to run a macro where it should get the last active line, copy all data to a new sheet, apply a filter (numbers on K row >15,9), copy and paste the results in a new sheet.
However, after aplying the filter, nothing is pasted in the new sheet.
Any ideas why?
Thank you!
Sub Macro1()
'Select and paste all data, couldn't work on a "last active line" in here..
Cells.Select
Selection.Copy
Sheets("Plan2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:O1").Select
Application.CutCopyMode = False
'Aplying the filter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$O$1056").AutoFilter Field:=11, Criteria1:=">15,9" _
, Operator:=xlAnd
'Here I'm trying to past the filtered data in the new sheet, but the result appears in blank
Cells.Select
Selection.Copy
Sheets("Plan3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Here i came back and turned the autofilter off, but it was useless
Sheets("Plan2").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$O$1056").AutoFilter Field:=11
End Sub
You have a few issues in the code:
Using Cells can be very tricky, especially when you don't define them well
Using Select is never a good practice. Just stick with working directly with objects (Sheets, Ranges, Workbooks, etc.).
I don't know why you need to copy the entire data set to a new sheet, then filter it to copy onto a 3rd sheet. It's possible to just filter the original data set and copy to the final sheet. I did not adjust the code for this, because there may be a reason you need to do this, but so you know, you can just work with the original data without the middle step of copying to another sheet to filter.
You may need to filter on 15.9 instead of 15,9, even if the comma is your decimal separator. (This may not be true, but I am adding it in in case it is (I don't have experience working on European systems in Excel.) Also, see David Zemens comment above.
In the below code, I have qualified all sheets and ranges, found the last row and provided comments where I made some assumptions. Modify it to fit your exact structure, and let me know if it works.
Sub Macro1()
'Select and paste all data, couldn't work on a "last active line" in here..
Dim wsCopy As Worksheet, wsPlan2 As Worksheet, wsPlan3 As Worksheet
Set wsCopy = Sheets("mySheet") ' replace with correct sheet name
Set wsPlan2 = Sheets("Plan2")
Set wsPlan3 = Sheets("Plan3")
'this will copy only cells with data in (*note -> this could copy more than that, but I will not go into it, for now, it's sufficient to use this)
With wsCopy
'find last row
Dim lRow As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:O" & lRow).Copy 'assume the data goes to column O, change if need be
End With
With wsPlan2
'paste to sheet Plan 2
.Range("A1").PasteSpecial xlPasteValues
'find last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:O" & lRow)
'Aplying the filter
.AutoFilter 11, ">15,9" 'you may need to use 15.9 here if you indeed mean 15 and 9/10ths. even if the comma separator is what you use to show decimals
.Copy
End With
wsPlan3.Range("A1").PasteSpecial xlPasteValues 'change range reference if you need it
.AutoFilterMode = False
End With
End Sub

Excel Macro to create a report file

I have an Excel workbook with two worksheets, Report and Data. I want to write a section of the Report tab out to a new workbook file (print range named "Roster") and retain the formatting, print settings, etc.
Below is the macro I have so far - it works but writes the whole Report tab to the file, not just the roster section, and it loses the print range which would be useful for the recipient of the resulting file.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+t
'
Dim Output As Workbook
Dim FileName As String
'This part updates the roster - grabs the next
'roster value and move it to A1, thus updating the report
Range("A1").Select
Selection.End(xlDown).Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Selection.ClearContents
Range("A1").Select
'Now we write the Report worksheet to a new file using
'the custom filename in cell AA1
Set Output = Workbooks.Add
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Report").Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats
FileName = Range("AA1").Value
Output.SaveAs FileName
Output.Close
End Sub
Your code is copying the whole Report tab because of the line
ThisWorkbook.Worksheets("Report").Cells.Copy
The .Cells gets all the cells of a worksheet. To get a portion you could try something like
ThisWorkbook.Worksheets("Report").Range(FirstCell, LastCell).Copy
where FirstCell and LastCell are the start and end of the range you want to copy. To duplicate the print area you could try something like
DestinationSheet.PageSetup.PrintArea = OriginalSheet.PageSetup.PrintArea
Hope that helps

Cut Paste data from excel sheet using Autofilter in Excel VBA

Current i have an excel with roughly 200000+ records and i need to filter data based on a column. The column has around 5 values and i need to filter out 2 values in one sheet and the rest 3 to remain in the same sheet.
Now instead of using cell by cell comparison to check whether the value of the cell falls in any of the above 2 values and then cut paste the row into another sheet. This wouldn't work with 200k+ records and simply hangs,.
Instead am planning to take the auto filter method. I tried using the 'Record macro' feature, but the problem is that it gives me some error like
"Excel cannot create or use the data range reference because its too complex.Try one of the following
Use data that can be selected in rectangle
Use data from the same sheet"
Moreover how to copy paste only the filtered values to another sheet? If I try to copy paste directly or special paste as 'values' then also even the hidden rows get copy pasted.
Below is the macro code i have been tampering around with
Sub Macro34()
'
' Macro34 Macro
'
'
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$81335").AutoFilter Field:=6, Criteria1:="=242", _
Operator:=xlOr, Criteria2:="=244"
Cells.Select
Selection.Copy
ActiveWindow.SmallScroll Down:=21
Sheets("Sheet2").Select
ActiveWindow.SmallScroll Down:=-18
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
Sheets("Sheet1").Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
ActiveWindow.SmallScroll Down:=93
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=-9
ActiveWindow.ScrollRow = 1
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
End Sub
There might be some junk lines of code above as its generated using the 'record macro' feature.
Could someone please help me. The problem is the amount of data present in excel. Cant excel not handle this much data in VBA? Am using Excel 2007
Here's your code cleaned up:
Sub Macro34()
' Turn off autofiltering
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
' Turn it back on
Rows(1).AutoFilter
' Set the autofiltering conditions
Rows(1).AutoFilter Field:=6, _
Criteria1:="=242", _
Operator:=xlOr, _
Criteria2:="=244"
' Copy only the relevant range
Range("A1", _
Cells(65536, Cells(1, 256).End(xlToLeft).Column).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
' Paste the data into Sheet2 (assuming that it exists)
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End Sub
The key is that SpecialCells part.
Now, as much as I love a good autofilter copy/paste, when you're dealing with that much data, you might want to look into using ADO, which would allow you to query your Excel worksheet using SQL.
A good overview of ADO in VBA is provided here: http://www.xtremevbtalk.com/showthread.php?t=217783.
In the 1st empty column to the right of your data insert a formula that tests for your criteria: e.g.
=if(or(a2=242,a2-244),"Move","Keep")
then in your macro, sort the whole 200,000 line data set by that column before you attempt the filter and cut visible code described in answer1.
This will make the block of data to be cut-n-pasted one contiguous range. This should get around the 'data range too complex' error.

Resources