Why does my VBA loop paste incorrect values? - vba

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.

Related

Copy and paste data and have it be updated automatically

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

Copy paste Loop

I want to make J3:N3 = T2:X2, then I want to copy the cells formulas of T2:X2 and paste, jump one and paste and so on. The code runs fine, but does not apply my formulas in any of the cells. Any idea what I am doing wrong?
WsScenarios.Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[1]C[-10]"
Range("T2").Select
Selection.AutoFill Destination:=Range("T2:X2"), Type:=xlFillDefault
Set RgnCopy = Range("T2:X2")
i = 4
Do While i <= LastRow
RgnCopy.Copy
Range(Cells(i, 20), Cells(i, 24)).PasteSpecial xlPasteFormulas
i = i + 2
Loop
Recording a macro using the Excel UI could be useful sometimes, but what matters more is to write the code in a way to get done what you want in a better way. Also you have to think about maintaning or developing the code more in future so I suggest to remove every element that is an indication of using the UI such as activating sheets, or getting inputs from the user through activecell, Select method etc.
As mentioned in one of the previous comments using Range("T2").FormulaR1C1 = "=R[1]C[-10]" would solve your problem, but if you consider two ranges as the origin and destination, then you can always do the job a lot faster and better with the least hassle to parametrise the code in a later time:
Sub CopyIt()
Dim rngOrigin As Range
Dim rngDestination As Range
Dim WS As Worksheet
Set WS = ActiveSheet
Set rngOrigin = WS.Range("T2:X2")
Set rngDestination = WS.Range("J3:N3")
rngDestination.NumberFormat = "General"
rngOrigin.Copy
rngDestination.PasteSpecial xlPasteFormulas
End Sub

Need VBA for loop referencing a named range which contains all the sheet names

I have a piece of "crude" code which copies some data from one sheet to Another, and the sheet-name from which the data is copied can be found in a cell. However, the number of sheets are now growing, and I have created a dynamic named range for the sheetnames, and would like to perform the following code for all the sheets in the dynamic range. My code looks like this:
Calculate
' get the worksheet name from cell AA3
Worksheets(Range("AA3").Value).Activate
' Copy the data
Range("A1:A1500").Select
Selection.Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Select
Dim NextRow As Range
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Now, I would like to have something like a loop with reference to the dynamic range but I am unable to get it to work as VBA really is not my cup of tea...So, instead of referencing AA3, AA4 etc I would like to referebnce the named range which contains the data of AA3, AA4....AAx. The named range might also contain blank cells, as it is the result of an Array formula in AA3....AA150.
Thank you!
/Fredrik
The following code should work for you. I assumed that the named range (i called it copysheets) is in the active workbook (scope workbook).
Sub copySheets()
Dim sheetName As Range
Dim copyRange As Range
Dim destinationRange As Range
For Each sheetName In Range("copysheets")
If sheetName.Value <> "" And sheetName.Value <> 0 Then
Set copyRange = Sheets(sheetName.Value).Range("A1:A1500")
Set destinationRange = Sheets("Artiklar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
copyRange.Copy
destinationRange.PasteSpecial xlPasteValues
End If
Next
End Sub
Dim myNamedRng as Range, cell as Range
'...
Set myNamedRng = Worksheets("MySheet").Range("myRange") '<-- set a variable referencing your named Range
With Sheets("Artiklar")
For Each cell In myNamedRng
If cell.Value <>"" Then .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1500).Value = Worksheets(cell.Value).Range("A1:A1500").Value
Next cell
End With
The following example loops through each cell in a named range by
using a For Each...Next loop. If the value of any cell in the range
exceeds the value of Limit, the cell color is changed to yellow.
vba
Sub ApplyColor()
Const Limit As Integer = 25
For Each c In Range("MyRange")
If c.Value > Limit Then
c.Interior.ColorIndex = 27
End If
Next c
End Sub
Source
So you might start off with something like this:
Calculate
Dim NextRow As Range
' get a range object from the named range
For Each c In Range("[File.xls]Sheet1!NamedRange")
' Copy the data
Worksheets(c.Value).Range("A1:A1500").Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Activate
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial xlPasteValues
Next c
You'll notice that I was a bit more explicit with how the named range is being referred to - the requirement here might vary depending on how you declared the range to begin with (what its scope is), but the way I did it will most likely work for you. See the linked article for more information about scope of named ranges.
-= Problem Solved =-
Thank you all for your contribution to my question! All the answers that I received has helped me refine my code, which is now functioning properly!
Regards,
Fredrik

Excel Shift Data down after Insert

Hopefully someone can help me out here :(
In a sequence of workbooks (never a good idea :)), a user runs a macro which copies data from Workbook1 and inserts it using Insert Shift:=xlDown in Workbook2.
The problem is this: there is taller rows and a grouped textbox below the destination, and instead of shifting these down, the macro leaves the row size large and the textbox doesn't move.
I have set the textbox group to Move and size with cells and tried CopyOrigin:=xlFormatFromLeftOrAbove but it seems to make no difference.
Can somebody help please?
Thanks
EDIT
Here is the full code: (commented out original idea, added suggestion below)
Sub MakeQuote2()
Application.ScreenUpdating = False
Dim sourceRange As Range, loopRange As Range
Dim targetRange As Range
Dim FRow As Long
Dim m As Long
Dim p As Long
m = Sheets("Workbook1").Rows.Count
FRow = Sheets("Workbook1").Range("A" & m).End(xlUp).Row
Set sourceRange = ActiveSheet.Range("A9:E" & FRow)
Set targetRange = Workbooks.Open("C:\Users\j\Documents\Trial1.xltm").Sheets("Workbook2").Range("A4")
sourceRange.Copy
Sheets("Workbook2").Rows("4:4").EntireRow.Insert 'Select
'Selection.Insert 'Shift:=xlDown
p = FRow + 5
Sheets("Workbook2").Rows("4:" & p).Copy
Sheets("Workbook2").Rows("4:4").PasteSpecial xlPasteValues
Sheets("Workbook2").Range("A2").Select
Application.CutCopyMode = False
Workbooks("Copy.xlsm").Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
Thanks!
If you want below text boxes to move and size with the cells above then it does not suffice to use
.Insert Shift:=xlDown
Instead you need to use
.EntireRow.Insert
If you copy entire rows, paste will shift everything down. If your copy source has only several columns, the data shifts down but no rows format or objects shift with it. This is true in Excel, not only in VBA.
This code works for me (I changed some of the references to test it in my environment):
Set sourceRange = Sheets("Sheet2").Range("A9:E" & FRow).EntireRow '<-- Added EntireRow here.
Set targetRange = Sheets("Sheet1").Range("A4") '<-- This is never used.
sourceRange.Copy
Sheets("Sheet1").Rows("4:4").EntireRow.Insert
The only addition I made is to add EntireRow to the source range to copy. If you need only columns A:E I would suggest you insert blank rows according to FRow - 9, and then copy and paste A:E in the added rows.
Note that you are mixing up references Sheets("Workbook1"), ActiveSheet in your original code, and you never use targetRange.
Addition
As mentioned in the first note, to add blank rows before you paste only the relevant columns, you can use something like this code:
Sheets("Sheet1").Rows("4:" & FRow - 9 + 4).EntireRow.Insert
Set sourceRange = Sheets("Sheet2").Range("A9:E" & FRow)
Set targetRange = Sheets("Sheet1").Range("A4")
sourceRange.Copy
targetRange.PasteSpecial

Paste and reference to undefined active cell

I am copying a value from one workbook to another and, when I paste it, I need the value to link back to its original source. I got it to work that the cell hyperlinks. However, I'm pasting into a variable cell, so it keeps pasting in the wrong location. Does anyone know how to make where I put stars ** below refer to the active cell?
Dim rng, clm As Range
With ActiveWindow
Set rng = Cells(ActiveCell.Row)
Set clm = Cells(ActiveCell.Column)
rng.Activate
clm.Activate
End With
With ActiveCell
Selection.PasteSpecial paste:=xlPasteValues
End With
With ActiveCell
.Hyperlinks.Add Anchor:=.Range(**rng, clm**), Address:=FilePath, ScreenTip:="The screenTIP", TextToDisplay:=FilePath
End With
Try the following instead of the second With ActiveCell:
With ActiveSheet
.Hyperlinks.Add Anchor:=ActiveCell, Address:=FilePath, ScreenTip:="The screenTIP", TextToDisplay:=FilePath
End With