I am trying to copy and paste a range in values without using the clipboard, below code works but doesn't copy in values (includes forumlas etc):
any ideas as how to make this work?
NbRowsPnLD1 = PnLD1WS.Range("A1").End(xlDown).Row
PnLD1WS.Range(PnLD1WS.Cells(1, 1), PnLD1WS.Cells(NbRowsPnLD1, 228)).Copy(PnLD2WS.Cells(1, 1)).PasteSpecial xlPasteValues
Copy the Values of a Range by Assignment
Option Explicit
Sub CopyByAssignment()
' It is assumed that 'PnLD1WS' and 'PnLD2WS' are the code names
' of two worksheets in the workbook containing this code.
' Calculate the last row,
' the row with the last non-empty cell in the column.
' Most of the time you want to use '.End(xlUp)' instead:
Dim slRow As Long
slRow = PnLD1WS.Cells(PnLD1WS.Rows.Count, "A").End(xlUp).Row
' ... because if you have empty cells in the column, it will reference
' the whole range regardlessly.
' The following will 'stop' at the first empty cell and may not reference
' the whole desired column range.
'slRow = PnLD1WS.Range("A1").End(xlDown).Row ' not recommended
' Reference the source range (the range to be copied from).
Dim srg As Range
Set srg = PnLD1WS.Range("A1", PnLD1WS.Cells(slRow, "HT"))
' Reference the destination range (the range to be written (pasted) to).
' Use 'Resize' to make it the same size as the source range.
Dim drg As Range
Set drg = PnLD2WS.Range("A1").Resize(srg.Rows.Count, srg.Columns.Count)
' Copy by assignment.
drg.Value = srg.Value
End Sub
Something like
With PnLD1WS.Range(PnLD1WS.Cells(1, 1), PnLD1WS.Cells(NbRowsPnLD1, 228))
PnLD2WS.Cells(1, 1).Resize(.Rows.Count,.Columns.Count).Value2 = .Value2
End With
Related
I'm trying to write a macro that would identify the last timestamp within a column, add a defined number of days and update a due date for every column in my data set, until it reaches a blank column.
This is a screenshot of the data set where I want the calc to run:
For other calculations, I'm using the ActiveCell.Offset to navigate my spreadsheet and run the calculations, but using it for this case is getting very confusing.
Sample of code for existing calculations:
ws.Range("B74").Select
Do Until ActiveCell.Offset(0, 1).Value = ""
ActiveCell.Offset(-23, 1).Formula = "=Round(((R[-2]C[0]+R[-4]C[0])/R[-14]C[0])*100,2)"
If IsError(ActiveCell.Offset(-23, 1)) Then ActiveCell.Offset(-23, 1).Value = "0"
ActiveCell.Offset(0, 1).Select
Loop
In your case I would define an user-defined function (place the macro in a standard module) and then use that function inside the sheet as formula. The function returns the value of the last non empty cell and you then can perform your calculation directly in the sheet. Value2 is used to get the underlying value of the cell without taking formats into account.
Looks like you're interested in the navigation part (title of question). I show you three ways to get the last (I hope I understood your definition of last correctly) non empty cell in a range with a width of 1 column:
Looping through range (getLastValueWithLoop)
Using .End(xlUp) (getLastValueWithEnd)
Writing range values to array and then loop the array (fastest) (getLastValueWithArrayLoop)
I also included a function (updateDueDateInEachColumn) that goes through each column and updates the due date programmatically to not have to use the user-defined function.
Btw: You could prolly ditch using macros and just use a normal formula (see screenshot).
Code:
' **
' Get the value of the last non empty cell in rng
' #param {Range} rng Range to look in, 1 column only
' #return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithLoop(A2:A6)
Public Function getLastValueWithLoop(rng As Range) As Variant
Dim i As Long
' Loop through range and check if cell is not empty
' Starts at the bottom and moves 1 cell up each time
For i = rng.Cells.Count To 1 Step -1
If rng(i).Value2 <> "" Then
getLastValueWithLoop = rng(i).Value
Exit Function
End If
Next
' if no value in range set to false
getLastValueWithLoop = False
End Function
' **
' Get the value of the last non empty cell in rng
' #param {Range} rng Range to look in, 1 column only
' #return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithEnd(A2:A6)
Public Function getLastValueWithEnd(rng As Range) As Variant
Dim i As Long
Dim lastCell As Range
Dim lastNonEmptyCell As Range
' Set last cell in range
Set lastCell = rng(rng.Cells.Count)
' Use .end(xlup) to get first non empty
' This is the same as using the keys CTRL + Up
If lastCell <> "" Then
' Needs to check if last cell is empty first as else
' end(xlup) would move up even if the cell is non empty
' Set as last non empty cell if not empty
getLastValueWithEnd = lastCell.Value2
Exit Function
Else
' Use end(xlup) to get the first non empty cell moving up from
' the last cell. Check if the cell found with end(xlup) is inside the range
' with .Intersect as end(xlup) can move outside the range provided
' If it is inside the range set last non empty cell
If Not Application.Intersect(rng, lastCell.End(xlUp)) Is Nothing Then
getLastValueWithEnd = lastCell.End(xlUp).Value2
Exit Function
End If
End If
' if no value in range set to false
getLastValueWithEnd = False
End Function
' **
' Get the value of the last non empty cell in rng
' #param {Range} rng Range to look in, 1 column only
' #return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithArrayLoop(A2:A6)
Public Function getLastValueWithArrayLoop(rng As Range) As Variant
Dim rngAsArray As Variant
Dim i As Long
' Write the rng values into an array
' This produces a two dimensional array
rngAsArray = rng.Value2
' Loop through the array, move from bottom up and
' return first non empty cell
For i = UBound(rngAsArray, 1) To LBound(rngAsArray, 1) Step -1
If rngAsArray(i, 1) <> "" Then
getLastValueWithArrayLoop = rngAsArray(i, 1)
Exit Function
End If
Next
' if no value in range set to false
getLastValueWithArrayLoop = False
End Function
' **
' Check rngColumn for last value (exit if none found) and
' update rngDueDate then move one column to the right etc.
' This macro relies on the function getLastValueWithLoop.
' #param {Range} rngColumn First column range to get last value in
' #param {Range} rngDueDate First cell to update due date in
' Example call in macro:
' updateDueDateInEachColumn Range("B2:B6"), Range("B7")
Public Sub updateDueDateInEachColumn(rngColumn As Range, rngDueDate As Range)
Dim rng As Range
Dim lastValue As Variant
' Loop until column is empty
Do
' Get last value of column range, returns false if no value found
lastValue = getLastValueWithLoop(rngColumn)
If lastValue = False Then
' Exit the loop if no value was found
Exit Do
Else
' Update due date
rngDueDate = lastValue + 10 ' TODO: add your calculation here
End If
' Offset column and due date range by one column
Set rngColumn = rngColumn.Offset(, 1)
Set rngDueDate = rngDueDate.Offset(, 1)
Loop
End Sub
Example usage of the functions inside a sheet:
I'm working on a macro to copy certain rows (if column A isn't blank) of worksheet 'A' to worksheet 'B'. After a little bit of research the following code suddenly appeared. Only thing that I don't seem to work out is to copy the cell values instead of the linked formula, I tried to implement the 'copy/paste special' command, but I don't get the specific coherent code language.
Sub Samenvattend()
'
' Samenvattend Macro
'
' Sneltoets: Ctrl+Shift+S
'
Dim a As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("gedetailleerde meetstaat")
Set Target = ActiveWorkbook.Worksheets("samenvattende meetstaat")
j = 1 ' Start copying to row 1 in target sheet
For Each a In Source.Range("A1:A10000") ' Do 10000 rows
If a <> "" Then
Source.Rows(a.Row).Copy Target.Rows(j)
j = j + 1
End If
Next a
End Sub
Thanks :)
If you're just trying to set the values of two cells equal, you can skip copy/paste, and simply set the ranges' values equal to one another.
This also lets you skip using the Clipboard and tends to be a little faster.
Just remember when doing this, it's [DESTINATION range].value = [ORIGIN range].value whereas with copy/paste, it's [ORIGIN range].copy [DESTINATION range].
For Each a In Source.Range("A1:A10000") ' Do 10000 rows
If a <> "" Then
Target.Rows(j).value = Source.Rows(a.Row).Value
j = j + 1
End If
Next a
I am trying to get the returns of a stock after each close date and list it in a column. My problem is that the start and end dates change and any cell that is not used for returns has to be completely cleared of contents. Here is what I have so far.
Sheets("returns").Range("a2").FormulaR1C1 = _
"=IFERROR(returns(Imported!RC[4],Imported!R[1]C[4]),"""")"
Sheets("returns").Range("a2").Select
Selection.AutoFill Destination:=Range("a2:a937")
Range("a2:a937").Select
Sheets("returns").Range("c2").FormulaR1C1 = _
"=IFERROR(returns(Imported!RC[10],Imported!R[1]C[10]),"""")"
Sheets("returns").Range("C2").Select
Selection.AutoFill Destination:=Range("c2:c937")
Range("C2:C937").Select
This works for what I need but it leaves a formula in the empty cells which I can't have for the next step of my project. It also leaves a -1 return in the last row when I run out of data. The -1 return isn't too big of a deal if that can't be fixed. Is there a way to clear the contents of a cell that doesn't contain a value but contains a formula?
Here’s what I think you want…
You have data in worksheet “Imported”
You want formulas in worksheet “returns” for the same number of rows that exist in worksheet “Imported”
Sub addFormulasBasedOnRecordCount()
' ========================================================
' jdoxey
' Version 1.0
' ========================================================
Dim wsWithData As Worksheet ' the name of the worksheet that has the data
Dim wsFormulas As Worksheet ' the name of the worksheet that you want the formulas in
Set wsWithData = Worksheets("imported") ' change the "name" to be what you want
Set wsFormulas = Worksheets("returns") ' change the "name" to be what you want
Dim activeRows As Long ' this will be the number of rows that have data
' gets the number of rows in "wsWithData",
' assumes that the data starts in "A1"
' and there are no empty rows
activeRows = wsWithData.Range("A1").CurrentRegion.Rows.Count
' puts the formula into column A starting with row 2 though the number of rows in "wsWithData"
wsFormulas.Range("A2:A" & activeRows). _
FormulaR1C1 = "=IFERROR(returns(Imported!RC[4],Imported!R[1]C[4]),"""")"
' puts the formula into column C starting with row 2 though the number of rows in "wsWithData"
wsFormulas.Range("C2:C" & activeRows). _
FormulaR1C1 = "=IFERROR(returns(Imported!RC[10],Imported!R[1]C[10]),"""")"
' ========================================================
' ========================================================
End Sub
Is it possible to copy a range to a virtual range or does it require me to sloppily paste it in another range in the workbook?
dim x as range
x = copy of Range("A1:A4")
obviously I usually use the following code
dim x as range
set x = Range("A1:A4")
but in the above example it only makes x a "shortcut" to that range rather than a copy of the range object itself. Which is usually what I want but lately I have been finding it would be quite useful to totally save a range and all it's properties in memory rather than in the workbook somewhere.
I think this is what you are trying to do:
'Set reference to range
Dim r As Range
Set r = Range("A1:A4")
'Load range contents to an array (in memory)
Dim v As Variant
v = r.Value
'Do stuff with the data just loaded, e.g.
'Add 123 to value of cell in 1st row, 3rd column of range
v(1,3) = v(1,3) + 123
'Write modified data back to some other range
Range("B1:B4").Value = v
Is it possible to copy a range to a virtual range?
No it is not possible. Range allways represents some existing instance(s) of cells on a worksheet in a workbook.
Does it require me to sloppily paste it in another range in the
workbook?
It depends on what you want to do. You can paste everithing from one range to another, you can paste only something like e.g. formulas to another range.
dim x as range
set x = Range("A1:A4")
But in the above example it only makes x a "shortcut" to that range
rather than a copy of the range object itself.
Variable x holds a reference to that specific range. It is not possible to made any standalone copy of a range. It is possible to create references to a range and to copy everithing / something from one range to another range.
Lately I have been finding it would be quite useful to totally save a
range and all it's properties in memory rather than in the workbook
somewhere.
Again, it is not possible to save all range properties to some virtual, standalone copy of specific Range because Range allways represents an existing, concrete set of cells. What you could do is to create your own class with some properties of a Range or even all properties ... but it will be some extra work to do.
Here some examples how to use range as parameter and copy it to another range. HTH.
Option Explicit
Sub Main()
Dim primaryRange As Range
Set primaryRange = Worksheets(1).Range("A1:D3")
CopyRangeAll someRange:=primaryRange
CopyRangeFormat someRange:=primaryRange
' Value property of a range represents and 2D array of values
' So it is usefull if only values are important and all the other properties do not matter.
Dim primaryRangeValues As Variant
primaryRangeValues = primaryRange.value
Debug.Print "primaryRangeValues (" & _
LBound(primaryRangeValues, 1) & " To " & UBound(primaryRangeValues, 1) & ", " & _
LBound(primaryRangeValues, 2) & " To " & UBound(primaryRangeValues, 2) & ")"
' Prints primaryRangeValues (1 To 3, 1 To 4)
Dim value As Variant
For Each value In primaryRangeValues
' This loop throught values is much quicker then to iterate through primaryRange.Cells itself.
' Use it to iterate through range when other properties except value does not matter.
Debug.Print value
Next value
End Sub
Private Sub CopyRangeAll(ByVal someRange As Range)
' Here all properties of someRange which can be copied are copied to another range.
' So the function gets a reference to specific range and uses all its properties for another range.
Dim secondaryRange As Range
Set secondaryRange = Worksheets(2).Range("D4:G6")
someRange.Copy secondaryRange
End Sub
Private Sub CopyRangeFormat(ByVal someRange As Range)
' Here only formats are copied.
' Function receives reference to specific range but uses only one special property of it in that another range.
Dim secondaryRange As Range
Set secondaryRange = Worksheets(3).Range("G7:J9")
someRange.Copy
secondaryRange.PasteSpecial xlPasteFormats ' and many more e.g. xlPasteFormulas, xlPasteValues etc.
End Sub
I begin the process of streamlining the work, so...
I need a VBA code that copy only the cells with value, within a range specified, to ONE column. I want that the effect will be immediate. Once I insert data the column will be update.
example:
copy only the cells with numbers, within a range A2:D9, to column F.
in the real VBA code I don't want it to be limited to a small range, because I have more column then A-D, and they long then 9 rows. So if I could define it a range (but in the code and not in new pop-up windows), this would be an excellent :)
the COLORS and column G are meaningless. This is just for example.
Screenshot:
Thank you for your patience and time...
Appreciate it very much !
Do it like this:
Sub Macro1()
'
' Macro1 Macro
'
Dim SourceRange As Range
Dim TargetRange As Range
Dim addedCells As Integer
'
Application.Calculation = xlManual
Set TargetRange = Range("F2:F34")
addedCells = 0
Set SourceRange = Range("A2:D9")
For Column = 1 To SourceRange.Columns.Count
For Row = 1 To SourceRange.Rows.Count
If Not (SourceRange.Cells(Row, Column) = "") Then
addedCells = addedCells + 1
TargetRange.Cells(addedCells, 1) = SourceRange.Cells(Row, Column)
End If
Next Row
Next Column
Calculate
Application.Calculation = xlAutomatic
End Sub
Add some parameters to make it dynamic.