I have been looking at this for 5+ hours not being able to find a correct solution. This isn't my main deal just what I do in work to help out.
Basically I am copying from a sheet that has filtered rows to another sheet and placing it at the last row in column A to paste.
This worked perfectly find before I did some changes and now it's completely broken, any help be gratefully appreciated, here is the broken lump of spaghetti code....
Sheets("Working Sheet").Select
Selection.Copy
Sheets("Sent Items").Select
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
Range("A" & LastRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("K:K").EntireColumn.AutoFit
Sheets("Sent Items").Select
It causes an error 1004 saying the size needs to be the same??? The paste causes the error. Any help is good have been looking for the answer.
you could refactor your code as follows:
Worksheets("Working Sheet").Select
Selection.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sent Items").Cells(Rows.Count, 1).End(xlUp).Offset(1)
or, if you are interested in pasting values only:
Dim area As Range
Worksheets("Working Sheet").Select
For Each area In Selection.SpecialCells(xlCellTypeVisible).Areas
Worksheets("Sent Items").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(area.Rows.Count, area.Columns.Count).Value = area.Value
Next area
Since you are copying filtered rows, it's always a good practice to use the SpecialCells method.
See the refactored code below. Also, always best to avoid using select and work directly with objects.
Dim wsWorking as Worksheet
Set wsWorking = Sheets("Working Sheet")
With wsWorking
.Select
Selection.SpecialCells(xlCellTypeVisible).Copy
End With
Dim wsSent as Worksheet
Set wsSent = Sheets("Sent Items")
With wsSent
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow).PasteSpecial
.Columns("K:K").EntireColumn.AutoFit
.Range("A1").Select 'to make sure you end up on that sheet
End With
Related
So I created a copy and paste function. I had help previously with an error I encountered. However, I am now wanting to make the values copy and pasted to be updated when the original date is changed. So, my original thought was to paste something like =(ws.Cells(i, j). And have a nested for loop to with the values i staying the same as below and j going in between 6 and 16. But I couldn't get that to work.
If there is a special paste function or something that I am unaware of that would be great. Is there a way to get copy and paste data but also have it still be reliant on the original (updates when the original is changed).
If there is another question with a solution to this problem then I didn't see it and I am sorry.
I have my code below. And any help would be appreciated.
Private Sub CommandButton1_Click()
Dim rng As Range
Dim ws As Worksheet
Set ws = Worksheets("Goals")
a = Worksheets("Goals").Cells(Rows.Count, 7).End(xlUp).Row
For i = 2 To a
If Worksheets("Goals").Cells(i, 20).Value = "Red" Then
ws.Activate
Set rng = ws.Range(ws.Cells(i, 6), ws.Cells(i, 16)) 'columns to be copied
rng.Copy
Worksheets("Scorecard").Activate
b = Worksheets("Scorecard").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Scorecard").Cells(b + 1, 2).Select
ActiveSheet.Paste
Worksheets("Goals").Activate
End If
Next
Application.CutCopyMode = False
Worksheets("Forms").Activate
Worksheets("Forms").Cells(22, 10).Select 'going back to the Forms page
End Sub
Try this
Worksheets("Goals").Range("I6:I16").Copy
Worksheets("Scorecard").Paste Link:=True
I hope you wont mind if the sheets switch in this process..
Thanks
I have created a loop where data is copied from a worksheet and pasted into another, however I am having problems with the paste function – sometimes the wrong data gets pasted, seemingly randomly. My current code is:
Sub ACCPR_LOOP()
Dim wsACC_PR As Worksheet
Set wsACC_PR = ThisWorkbook.Sheets("ACC PR")
Dim wsPR_CALC As Worksheet
Set wsPR_CALC = ThisWorkbook.Sheets("PR - CALC")
Dim MyRange As Range
Dim MyCell As Range
Set MyRange = Range("A2:A145")
Application.ScreenUpdating = False
Columns("B:C").ClearContents
For Each MyCell In MyRange
MyCell.Copy
wsPR_CALC.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wsPR_CALC.Range("B226,B228").Copy
MyCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Next MyCell
End Sub
What the code is doing is in Col A are a bunch of dates, it copies the date in A, then pastes it into another worksheet to update a drop-down date selector and change the data. Two of the cells are then copied and pasted back into the original worksheet with an offset of 1 column. For some reason sometimes, the data from the previous date in A is pasted. For example, the date in A17 is copied and pasted into the date selector, the correct data is then pasted into B17, but on the next step, the data relating to A17 is pasted into the next row down at B18.
If a repeat the line:
MyCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
the code works but this seems rather inefficient. Any ideas what’s going on in my code and how I can fix it?
In the Set MyRange = Range("A2:A145") you should declare the corresponding worksheet as well. E.g.:
Set MyRange = Worksheets("MyNameIsWhat").Range("A2:A145")
Otherwise, it would take the ActiveWorksheet and the MyRange would be assigned to it.
The same goes to Columns("B:C").ClearContents.
It should be Worksheets("TsakaTsakaSlimShaddy").Columns("B:C").ClearConents
I always try to avoid the copy/paste function in VBA. It's processor intensive and functions ... arcanely.
Try this instead:
For Each MyCell In MyRange
wsPR_CALC.Range("A1").Value = MyCell.Value
Application.Calculate
MyCell.Offset(0, 1).Value = wsPR_CALC.Range("B226,B228").Value
Next MyCell
You'll lose the number formatting, but there are other ways of doing that.
I also added an Application.Calculate line, because it looks like you're copying from a formula in the second step, and it's good to make sure that value gets updated. You can also try Application.CalculateFull if plain .Calculate isn't cutting it.
Also, to echo Vit, if you're working with multiple sheets, declaring your sheet as often as possible will help as well.
I'm new to VBA and I have recently been creating a few macros. I currently have one that works, but it isn't very cooperative at times. I've done a bunch of reading on how to optimize VBA code, but I'm still not getting very far. I understand using Select is bad, and I've removed as much of the Select lines as I could on my own. I've also read that many if statements combined with loops can be hard to run as well (of course I have multiples of both).
So I know some of the reasons why my code is bad, but I don't really know how to fix it. I added
Application.ScreenUpdating = False
Application.ScreenUpdating = True
to my macro as well. This has helped, but not much. I have other macros that can run for a long time and never freeze up. This macro freezes if it doesn't finish in 10-15 seconds. If I only have a couple 100 rows of data it runs no problem. If I have a few 1000 lines of data it doesn't finish before it freezes.
Option Explicit
Sub FillGainerPrices()
Application.ScreenUpdating = False
'Search each name on "Gainer Prices" and if the same name is on "Gainers", but not on Gainer Prices _
move it over to Gainer Prices tab. Then call Historical Query and Fill Names
Dim LastRow1 As Long
LastRow1 = Sheets("Gainers").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim LastRow2 As Long
LastRow2 = Sheets("Gainer Prices").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim Name1 As Range
Dim Name2 As Range
For Each Name1 In Sheets("Gainers").Range("B2:B" & LastRow1)
Set Name2 = Sheets("Gainer Prices").Range("A2:A" & LastRow2).Find(Name1, LookIn:=xlValues, LookAt:=xlWhole)
If Name2 Is Nothing Then
If Name1.Offset(0, -1) < Date - 15 Then
Name1.Copy
Sheets("Gainer Prices").Select
Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
Call HistoricalQuery
End If
End If
Next Name1
Application.ScreenUpdating = True
'Fill in Names and remaining symbols here
Call FillNamesAndSymbols
End Sub
Call HistoricalQuery and Call FillNamesAndSybmols are pretty quick and do not seem to have any issues when I run them by themselves so I don't think they are causing the problem. I'm guessing the issue is searching for one Name 1000's of times and then copying and pasting over and over, but I can't figure out how to get rid of the copy and paste part without the macro giving me wrong results.
The end goal of the macro is to go to the 2nd sheet and see if those names are on the first sheet. If not, it moves the names over, and then for each name it moves over it calls another macro to pull historical data for that name. Finally at the end it just does some formatting and filling in or deleting of blank cells. If anyone can direct me in the correct direction I would appreciate it. Thanks!
Try this code.
Improvments:
Timing: my code: 0.8828125 sec, your code: 10.003 sec. (tested with 1000 rows in both sheets)
I'm using array to store values from second sheet: arr = Sheets("Gainer Prices").Range("A2:A" & LastRow2).Value - much faster for huge data
I'm using Application.Match instead Range.Find - it's faster as well.
I'm using Range(..).Value = Range(..).Value instead copy/paste
avoid using select/active statement
Sub FillGainerPrices()
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim Lastrow3 As Long
Dim Name1 As Range
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim arr As Variant
'remember start time
Dim start as Long
start = Timer
Application.ScreenUpdating = False
Set sh1 = ThisWorkbook.Sheets("Gainers")
Set sh2 = ThisWorkbook.Sheets("Gainer Prices")
With sh1
LastRow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
With sh2
LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
arr = .Range("A2:A" & LastRow2).Value
End With
For Each Name1 In sh1.Range("B2:B" & LastRow1)
If IsError(Application.Match(Name1.Value, arr, 0)) Then
If Name1.Offset(0, -1) < Date - 15 Then
With sh2
Lastrow3 = .Cells(.Rows.Count, "C").End(xlUp).Row
.Range("A" & Lastrow3 + 1).Value = Name1.Value
End With
Call HistoricalQuery
End If
End If
Next Name1
'Fill in Names and remaining symbols here
Call FillNamesAndSymbols
Application.ScreenUpdating = True
'To see timing result press CTRL+G in the VBE window, or change Debug.Print to MsgBox
Debug.Print "Code evaluates for: " & Timer - start
End Sub
instead of
Name1.Copy
Sheets("Gainer Prices").Select
Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
you might try something like this:
Name1.copy destination:=Sheets("Gainer Prices").Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2)
or perhaps
Sheets("Gainer Prices").Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2).value=Name1.value
I've looked around the forum and played with various options but not found a clear match for my problem:
My task is to copy data from a worksheet (called “workorders”) to a second worksheet (called “Assignments”). The data to be copied is from the “workorders” worksheet starting at cell range “E2, P2:S2”; and also copied from each row (same range) until column “P” is empty – (the number of rows to be copied can vary each time we need to run this macro so we can’t select a standard range) . Then pasted into the “Assignments” worksheet, starting at cell “A4”. I’ve used the forum so far to successfully copy a single row of date (from row 2) – I admit that’s the easy part, and I’ve used various versions of code to achieve this.
I’ve also tried some code (which I found via watching a youtube clip and modifying http://www.youtube.com/watch?v=PyNWL0DXXtQ )to allow me to run a loop which repeats the copy process for each required row in the “workorders” worksheet and then pastes the data into the “assignments” worksheet- but this is where I am not getting it right, I think I’m along the right lines and think I’m not far off but any help would be very useful.
Code examples below (first 2 only copy first row, 3rd example is where I’ve tried to loop and copy multiple rows:
Sub CopyTest1()
' CopyTest1 Macro
'copy data from workorders sheet
'Worksheets("workorders").Range("E2,P2,Q2,R2,S2").Copy
Worksheets("workorders").Range("E2, P2:S2").Copy
'paste data to assignments sheet
'sheets("assigments dc").Range("A4").Paste
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Sub CopyTest2()
Sheets("workorders").Range("e2,p2,q2,r2,s2").Copy Sheets("assigments dc").Range("a4")
End Sub
Sub CopyTest3()
Dim xrow As Long
'Dim xrow As String
xrow = 2
Worksheets("workorders").Select
Dim lastrow As Long
lastrow = Cells(Rows.Count, 16).End(xlUp).Row
Do Until xrow = lastrow + 1
ActiveSheet.Cells(xrow, 16).Select
If ActiveCell.Text = Not Null Then
'Range("E2,P2,Q2,R2,S2").Copy
'Selection = Range("E2,P2,Q2,R2,S2").Copy
'Cells(xrow, 5).Copy
Cells(xrow, 5).Copy
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("workorders").Select
End If
xrow = xrow + 1
Loop
End Sub
Try this:
Sub LoopCopy()
Dim shWO As Worksheet, shAss As Worksheet
Dim WOLastRow As Long, Iter As Long
Dim RngToCopy As Range, RngToPaste As Range
With ThisWorkbook
Set shWO = .Sheets("Workorders") 'Modify as necessary.
Set shAss = .Sheets("Assignments") 'Modify as necessary.
End With
'Get the row index of the last populated row in column P.
'Change accordingly if you want to use another column as basis.
'Two versions of getting the last row are provided.
WOLastRow = shWO.Range("P2").End(xlDown).Row
'WOLastRow = shWO.Range("P" & Rows.Count).End(xlUp).Row
For Iter = 2 to WOLastRow
Set RngToPaste = shAss.Range("A" & (Iter + 2))
With shWO
Set RngToCopy = Union(.Range("E" & Iter), .Range("P" & Iter & ":S" & Iter))
RngToCopy.Copy RngToPaste
End With
Next Iter
End Sub
Read the comments first and test.
Let us know if this helps.
From what I see, you are only copying the cell in Column E. You could correct this by replacing Cells(xrow, 5).Copy with
Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Copy
However, using Select and Copy are not ideal. Instead, you can assign the value of the range directly:
Sheets("Assignments DC").Range("A4").Value = Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Value
More info on the Union method and why using Select is bad.
Is it even possible to run a line like this?
Worksheets("workorders").Range("E2, P2:S2").Copy
Each time I try different ways to copy/select a range which contains in my case, A3 and the range A34:C40 ("A3, A34:C40").Copy i get an error saying theres to many parameters.. Could this be because I'm running excel 2007?
Any tips or help would be greatly apreciated! :)
I do not have much experience with writing macros, and therefore need the help of this community for the following issue encountered:
My macro copies a range of values entered in a vertical range in one worksheet and then pastes the values horizontally (transpose) in another worksheet. It would in theory paste the values from the first sheet to first row of the second worksheet which does not have content. Since the first five rows have contents, it thus pastes the values to the sixth row.
The problem I have with the running of the macro is that I feel like it is too slow and I would therefore like it to run faster.
I have the same macro doing the same thing but that instead pastes the values to another worksheet to the first row, and it runs perfect.
My best guess is therefore that the second macro is running slow because it has to start pasting on the sixth row and there may be some contents on the first 5 rows that take a lot of time for the macro to go through (there a lot of cell references to other workbooks) to determine where the next row for pasting should be. That is my best guess though and since I hardly know anything about macros, I cannot say for sure what the problem is.
I hereby provide you with the code of my macro and sincerely hope that somebody can tell me what is making my macro slow and provide me with a solution as to how to make it run faster. I am thinking that a solution might potentially be that the macro should not consider the first five rows of data and start pasting immediately on row 6 for the first entry. Then on row 7 the next time, and etc. This might be a solution but I do not know how to write the code in a way that it would do that.
Thank you for taking time and helping me to find a solution, here is the code:
Sub Macro1()
Application.ScreenUpdating = False
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myCopy As Range
Dim myTest As Range
Dim lRsp As Long
Set inputWks = wksPartsDataEntry
Set historyWks = Sheet11
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry2")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
myCopy.Copy
.Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub
Just reiterating what has already been said:
Option Explicit
Sub Macro1()
'turn off as much background processes as possible
With Excel.Application
.ScreenUpdating = False
.Calculation = Excel.xlCalculationManual
.EnableEvents = False
End With
Dim historyWks As Excel.Worksheet
Dim inputWks As Excel.Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myCopy As Excel.Range
Dim myTest As Excel.Range
Dim lRsp As Long
Set inputWks = wksPartsDataEntry
Set historyWks = Sheet11
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("OrderEntry2")
With historyWks
nextRow = .Cells(.Rows.Count, 1).End(Excel.xlUp).Offset(1, 0).Row
End With
With inputWks
Set myTest = myCopy.Offset(0, 2)
If Excel.Application.Count(myTest) > 0 Then
MsgBox "Please fill in all the cells!"
GoTo QuickExit
End If
End With
With historyWks
With .Cells(nextRow, 1)
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, 2).Value = Excel.Application.UserName
oCol = 3
myCopy.Copy
.Cells(nextRow, 3).PasteSpecial Paste:=Excel.xlPasteValues, Transpose:=True
Excel.Application.CutCopyMode = False
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With myCopy.Cells.SpecialCells(Excel.xlCellTypeConstants)
.ClearContents
Excel.Application.Goto .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
Calculate
QuickExit
With Excel.Application
.ScreenUpdating = True
.Calculation = Excel.xlAutomatic
.EnableEvents = True
End With
End Sub
I'd step through the macro line-by-line to try to locate which line is slow.
Another alternative - although not sure if it'll speed things up - is to avoid the clipboard and lose the copy/paste so you'd apply a method like the following to move the data:
Option Explicit
Sub WithoutPastespecial()
'WORKING EXAMPLE
Dim firstRange As Range
Dim secondRange As Range
Set firstRange = ThisWorkbook.Worksheets("Cut Sheet").Range("S4:S2000")
With ThisWorkbook.Worksheets("Cutsheets")
Set secondRange = .Range("A" & .Rows.Count).End(Excel.xlUp).Offset(1)
End With
With firstRange
Set secondRange = secondRange.Resize(.Rows.Count, .Columns.Count)
End With
secondRange.Value = firstRange.Value
End Sub
Best way to improve performance based on my experience is to work on variables in code rather than accessing the spreadsheet every time you want to lookup a value.
Save any range you want to work with in a variable(variant) and then iterate through it as if it was the sheet.
dim maxRows as double
dim maxCols as integer.
dim data as variant
with someSheet
maxRows = .Cells(rows.count, 1).end(xlUp).row 'Max rows in sheet
maxCols = .Cells(1, columns.count).end(xlToLeft).column 'max columns in sheet
data = .Range(.Cells(1,1), .Cells(maxRows, maxCols)) 'copy range in a variable
end with
From here you can access the data variable as if it was the spreadsheet like - data(row, column) with MUCH MUCH faster read speed.
Please take a look at this article as well.
How to speed up calculation and improve performance...
By all means, Application.calculation= xlCalculationManual is usually the culprit. But we can notice that volatile Excel sheet functions can mostly kill your application on large scale of data processing and functional aspect.
Also, for your current code following post might not be directly relevant. I find it useful for tips on over-all Excel/VBA performance optimization.
75 Excel speeding up tips
PS: I don't have enough reputation to comment on your post. So added as an answer..
Just a few suggestions (would have posted as a comment but I guess I don't have the rep):
Try refering to cell addresses instead of named ranges (doubt this would be the cause but may be causing some hit to performance)
Do your workbook formulas contain links to other workbooks? Try testing the code on a file with broken links to see if it improves performance.
If neither of these are the issue, my guess is that if the formulas are overly complex, there is probably some processing overhead being added. Try the code on a file containing only values to see if there is any improved performance.
As suggested by a few others in the comments, you should definitely change Application.Calculation to xlCalculationManual and rememeber to set it back to xlcalculationAutomatic at the end. Also try setting Application.Screenupdating = False (and turning that back on again too). Also, bear in mind that .Copy is a very inefficient way to copy cell values - if you really just want the values, loop through the range setting .Value to the .Values in the old range. If you need all the formatting, you're probably stuck with .Copy.
When you turn off the calc/screen refresh flags, please remember to turn them back on in all circumstances (even when your program exits at a different point, or causes a runtime error). Otherwise all sorts of bad things will happen. :)
You can improve the speed by stopping calculation during changing cell value and after that you can enable it. please follow the link.
http://webtech-training.blogspot.in/2013/10/how-to-stop-heavy-formula-calculation.html
.Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
I wouldn't do that. Cut,copy & Paste operations are the costliest operations, in terms of processor utilization, in an operating system.
Instead, you could just assign the value from one cell / range to an another cell / range, as in
Cells(1,1) = Cells(1,2) or Range("A1") = Range("B1")
Hope you got my point..