In below code I need to copy a range from "Output for qualifying" and insert as values in "Output".
It works, but I need the code to stop copy the range when column A start to contain the value zero (0).
Is there a smart way to do that? Hope you guys can help me.
Sub Copy_to_output()
Worksheets("Output for qualifying").Range("A2:A400").Copy
Worksheets("Output").Range("A9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("B2:H400").Copy
Worksheets("Output").Range("E9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("J2:K400").Copy
Worksheets("Output").Range("L9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("Q2:Y400").Copy
Worksheets("Output").Range("N9").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
The only thing I can think of in your situation is to use the Find method.
So, in your code, find the first 0 value, then use that as your row reference for the copy. This is by no means a clean way for the operation, but will do the task.
Sub Copy_to_output()
Dim lZeroRow As Long
lZeroRow = Worksheets("Output for qualifying").Range("A:A").Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole).Row
Worksheets("Output for qualifying").Range("A2:A" & lZeroRow).Copy
Worksheets("Output").Range("A9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("B2:H" & lZeroRow).Copy
Worksheets("Output").Range("E9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("J2:K" & lZeroRow).Copy
Worksheets("Output").Range("L9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("Q2:Y" & lZeroRow).Copy
Worksheets("Output").Range("N9").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Try the next code, please:
Sub Copy_to_output()
Dim shOFQ As Worksheet, shO As Worksheet, lastRow As Long
Set shOFQ = Worksheets("Output for qualifying")
Set shO = Worksheets("Output")
lastRow = shOFQ.Range("A:A").Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole).row
shO.Range("A9").Resize(lastRow, 1).Value = shOFQ.Range("A2:A" & lastRow).Value
shO.Range("E9").Resize(lastRow, shOFQ.Range("B2:H" & lastRow).Columns.Count).Value = shOFQ.Range("B2:H" & lastRow).Value
shO.Range("L9").Resize(lastRow, shOFQ.Range("J2:K" & lastRow).Columns.Count).Value = shOFQ.Range("J2:K" & lastRow).Value
shO.Range("N9").Resize(lastRow, shOFQ.Range("Q2:Y" & lastRow).Columns.Count).Value = shOFQ.Range("Q2:Y" & lastRow).Value
End Sub
No need to use Copy Paste...
Related
I have this code running smoothly when I step through the code (F8), but when I run it with F5 or call it to run from a button it doesn't do what it's supposed to. It only does the lookup in the first cell (Q2) and leaves the rest blank - like it skipped to run the formula down to the last row.
How can I improve my code to make sure that it always runs as it should?
Sub LookupFilename()
' Looks up the filename to be set according to Team Name
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LastRow)
Application.ScreenUpdating = True
MsgBox "Successful data collection.", vbInformation, "Success"
End Sub
There is no need to Select or use ActiveCell or AutoFill. Replace:
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LastRow)
with:
Range("Q2:Q" & LastRow).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Note, you shouldn't be Activateing either. Instead, qualify your Range, Cells, and Rows calls with the appropriate worksheet. Note the . before Cells, Rows and Range below:
Dim Data As Worksheet
Set Data = ThisWorkbook.Worksheets("Data")
With Data
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("Q2:Q" & LastRow).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
End With
This question already has answers here:
Copy from one workbook and paste into another
(2 answers)
Closed 4 years ago.
The full code is listed below, I'm copying and data from cell DB10 from the PivotTables sheet to column N in the Checklists sheet - also note that the rows in the Checklists sheet is dynamic and grows by 3018 rows each weekly...this is the part that slows down the processign time (I timed it and it takes ~8 minutes to complete processing when running the code)
This part is where things slow down:
Sheets("PivotTables").Select
Range("DB10").Select
Selection.Copy
Sheets("Checklists").Select
Dim rng As Range
NRowCount = Cells(Rows.Count, 1).End(xlUp).Offset(-3017).Row
ARowCount = Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In Range("N" & NRowCount & ":N" & ARowCount)
rng.PasteSpecial xlPasteValues
Next rng
Full code:
Sub WeeklyUpdate()
Application.ScreenUpdating = False
'
' WeeklyUpdate Macro
'
'
Sheets("Checklists").Select
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A3:M" & LR).SpecialCells(xlCellTypeVisible).Select
'
Selection.Copy
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Sheets("Checklists").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
xlPasteValues
Sheets("Checklists").AutoFilterMode = False
Sheets("PivotTables").Select
Range("DB10").Select
Selection.Copy
Sheets("Checklists").Select
Dim rng As Range
NRowCount = Cells(Rows.Count, 1).End(xlUp).Offset(-3017).Row
ARowCount = Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In Range("N" & NRowCount & ":N" & ARowCount)
rng.PasteSpecial xlPasteValues
Next rng
Sheets("Home").Select
Application.ScreenUpdating = True
End Sub
If I'm understanding correctly, you're just pasting the value in cell DB10 into the range N[NRowCount]:N[ARowCount].
Rather than doing a For loop, just try something along the lines of:
Range("N" & NRowCount & ":N" & ARowCount).Value = Range("DB10").Value
It eliminates the loop and should be immediate.
Your final code would look roughly as follows:
...
Sheets("Checklists").AutoFilterMode = False
Sheets("Checklists").Range("N" & NRowCount & ":N" & ARowCount).Value = Sheets("PivotTables").Range("DB10").Value
Sheets("Home").Select
PasteValues is the most frustrating thing in VBA! Could greatly use some help.
In short, I am trying to copy one row and pastespecial values that row into another row on a separate sheet. I thought it was a row issue, so I then modified my range and tried pasting that, also to no avail. I even tried recording a macro and the generated code is almost the exact same as mine.
Can someone please help? I've been looking at this too long :/
Sub CopyXs()
Dim counter As Double
Dim CopyRange As String
Dim NewRange As String
counter = 2
For Each Cell In ThisWorkbook.Sheets("LD_Tracker_CEPFA").Range("A7:A500")
If Cell.Value = "X" Then
Sheets("Upload_Sheet").Select
matchrow = Cell.Row
counter = counter + 1
Let CopyRange = "A" & matchrow & ":" & "Y" & matchrow
Let NewRange = "A" & counter & ":" & "Y" & counter
Range(CopyRange).Select
Selection.Copy
Sheets("Final_Upload").Select
ActiveSheet.Range(NewRange).Select
Selection.PasteSpecial Paste = xlPasteValues
Sheets("Upload_Sheet").Select
End If
Next
End Sub
I was struggling also with Paste.Special. This code works for me. The code you get when you record a macro for Paste.Special is not working. You first have to define a range and then used the code for Paste.Special
Range(something).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'This code works for me:
'**Select everything on the active sheet**
Range("A1").Select
Dim rangeTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngTemp Is Nothing Then Range(Cells(4, 1), rngTemp).Select
End if
' **Copy the selected range**
Selection.Copy
'**Select the destination and go to the last cel in column A and then go 2 cells down
'and paste the values**
Sheets("your sheet name").Select
Range("A" & Cells.Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
**'Select the last cell in column A**
Range("A" & Cells.Rows.Count).End(xlUp).Select
I have some formulas in a row. I want to copy them down to the end of the rest of my data.
When using normal formulas, the following code works:
With Sheets("Sheet1")
Set formRange = Range(.Range("G2"), .Range("O2").End(xlToRight))
formRange.Copy
formRange.Resize(Range("D" & Rows.Count).End(xlUp).Row - 1).PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
.Range("A1").Select
End With
However, when I replace some formulas with array formulas, I get a Run-time error 1004 that says PasteSpecial method of Range class failed.
Is there any way around this?
As commented, you cannot change part of an array. So try this:
Dim formRange As Range, arrForm As String
With Sheets("Sheet1")
Set formRange = Range(.Range("G2"), _
.Range("O2").End(xlToRight))
arrForm = formRange.FormulaArray
formRange.ClearContents
formRange.Resize(.Range("D" & _
.Rows.Count).End(xlUp).Row - 1).FormulaArray = arrForm
End With
Btw, take note of the extra dots I put in this line:
formRange.Resize(.Range("D" & _
.Rows.Count).End(xlUp).Row - 1).FormulaArray = arrForm
I assumed that you are pertaining to D Column of the same sheet.
Above works if it is just one array formula output in several ranges.
If each cell has different array formula, then just add offset in your code like this:
With Sheets("Sheet1")
Set formRange = Range(.Range("G2"), _
.Range("O2").End(xlToRight))
formRange.Copy
formRange.Offset(1, 0).Resize(.Range("D" & _
.Rows.Count).End(xlUp).Row - 1).PasteSpecial xlPasteFormulas
End With
You need to use the Range.FormulaArray method:
With Worksheets("Sheet1")
Set formRange = Range(.Range("G2"), .Range("O2").End(xlToRight))
formRange.Copy
Set newRange = (Range("D" & Rows.Count).End(xlUp).Row - 1)
newRange.FormulaArray = formRange
Application.CutCopyMode = False
.Range("A1").Select
End With
Can you explain how I can get away from using select and copy in this code? I want to make it run as efficiently as possible and without screen updating. I know I can set the screenupdating = false, but i prefer to just have the code written better!
Dim i As Integer
For i = 4 To 501
Sheets("Repository").Range("B" & i).Copy
Sheets("Input").Activate
Sheets("Input").Range("M13").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Input").Range("M21").Copy
Sheets("Repository").Activate
Sheets("Repository").Range("E" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Input").Range("U12").Copy
Sheets("Repository").Activate
Sheets("Repository").Range("C" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Input").Range("V12").Copy
Sheets("Repository").Activate
Sheets("Repository").Range("D" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues
Next i
Thanks so much.
If you're only moving values from one cell to another, there's no need to copy/paste. If you have to copy a lot of formatting over then there may be a need for it. This should accomplish the same thing, in my view it's the simplest way to go about it--
Dim wsRepository as Worksheet
Set wsRepository = ThisWorkbook.Sheets("Repository")
Dim wsInput as Worksheet
Set wsInput = ThisWorkbook.Sheets("Input")
Dim i As Integer
For i = 4 To 501
wsInput.Range("M13") = wsRepository.Range("B" & i)
wsRepository.Range("E" & i) = wsInput.Range("M21")
wsRepository.Range("C" & i) = wsInput.Range("U12")
wsRepository.Range("D" & i) = wsInput.Range("V12")
Next i
You can eliminate a lot of the activating and selecting. Here's how I would write it:
Application.ScreenUpdating = False
For i = 4 To 501
Sheets("Repository").Range("B" & i).Copy
Sheets("Input").Range("M13").PasteSpecial Paste:=xlPasteValues
Sheets("Input").Range("M21").Copy
Sheets("Repository").Range("E" & i).PasteSpecial Paste:=xlPasteValues
Sheets("Input").Range("U12").Copy
Sheets("Repository").Range("C" & i).PasteSpecial Paste:=xlPasteValues
Sheets("Input").Range("V12").Copy
Sheets("Repository").Range("D" & i).PasteSpecial Paste:=xlPasteValues
Next i
Application.ScreenUpdating = True
I would still recommend setting screenupdate to false. It will run a lot faster if it doesn't need to show the user each action it's taking.
First of all you don't need to select/activate/copy... you can simply assign values from one cell to another (with/without using variables). I would do this:
Sub test()
Dim i As Long 'Integer has a strict limit
Dim j As Integer
Dim RepositoryWs As Worksheet
Dim InputWs As Worksheet
Dim destinationCell(1 To 4) As Range
Dim sourceCell(1 To 4) As Range
Set RepositoryWs = Worksheets("Repository")
Set InputWs = Worksheets("Input")
'Static ranges
With InputWs
Set destinationCell(1) = .Range("M13")
Set sourceCell(2) = .Range("M21")
Set sourceCell(3) = .Range("U12")
Set sourceCell(4) = .Range("V12")
End With
For i = 4 To RepositoryWs.Range("B4").End(xlDown).Row 'Not hardcoded -> it works if you'll have more data on Repository sheet
'Dynamic ranges
With RepositoryWs
Set sourceCell(1) = .Range("B" & i)
Set destinationCell(2) = .Range("E" & i)
Set destinationCell(3) = .Range("C" & i)
Set destinationCell(4) = .Range("D" & i)
End With
For j = 1 To 4
destinationCell(j).Value = sourceCell(j).Value
Next j
Next i
End Sub