I am learning to copy and paste with VBA automatically without overwriting data.
I managed to get a code to copy from rows and paste them as rows.
Now, I want to copy rows (Same way) but paste them as a column each time.
The first line has to start with a date stamp (Each month) and underneath it the amounts. The amounts are being copied from a pivot table which will refresh then each month.
Here is my written code:
Private Sub CommandButton1_Click()
Dim lastrow As Long, ecol As Long
'Stamp from when the data set is (in months)
If Worksheets("Database").Range("A3").Offset(1, 1) <> "" Then
Worksheets("Database").Range("A3").End(xlDown).Select
ActiveCell.Offset(1, 0).FormulaR1C1 = Now
End If
'To check the last filled line on sheet 'Database_Input'
lastrow = Sheet12.Cells(Rows.Count, 2).End(xlUp).Row
'Copy Paste section
For i = 2 To lastrow
Sheet12.Cells(i, 2).Copy
ecol = Sheet14.Cells(3, Columns.Count).End(xlToRight).Offset(0, 1).Column
ecol = Sheet14.Cells(3, Columns.Count).End
Sheet12.Paste Destination:=Sheet14.Cells(3, ecol)
Next i
End Sub
It keeps giving me an error on the following section:
For i = 2 To lastrow
Sheet12.Cells(i, 2).Copy
ecol = Sheet14.Cells(3, Columns.Count).End(xlToRight).Offset(0, 1).Column
ecol = Sheet14.Cells(3, Columns.Count).End
Sheet12.Paste Destination:=Sheet14.Cells(3, ecol)
Next i
Anyone who has an idea how to deal with this? I copied my row --> row code and edited it. Maybe it has to be completely different.
Many thanks!
You are wanting the Column property of the Range, not Columns.
Also, you can transfer the value directly which is slightly more efficient than copying and pasting.
I have made a semi-educated guess as to desired destination range.
For i = 2 To lastrow
ecol = Sheet14.Cells(3, Columns.Count).End(xlToleft).Offset(0, 1).Column 'not columns at the end
Sheet14.Cells(3, ecol).Value = Sheet12.Cells(i, 2).Value
Next i
I didn't even look into your code, if what you want is just transpose version of the data, get your data into an array (range.value will give array) just use a loop to transpose and then assign it to a new range.
If you want them to contain formula use range.formula instead of value. just be sure to care about relative/absolute references.
Related
Essentially, I have data in three columns and a model on a separate tab. The data tab has 1,000 rows of data, and each entry will be run through the model, with results being pasted into the fourth column.
Here's what one iteration would look like, but I need it to loop through every row.
Worksheets("Data").Range("E2:G2").Copy _
Worksheets("Model").Range("B4:D4").PasteSpecial Paste:=xlPasteValues
Calculate
Worksheets("Model").Range("C120").Copy_
Worksheets("Data").Range("H2").PasteSpecial Paste:=xlPasteValues
Worksheets("Model").Range("C121").Copy_
Worksheets("Data").Range("I2").PasteSpecial Paste:=xlPasteValues
Worksheets("Model").Range("C122").Copy_
Worksheets("Data").Range("J2").PasteSpecial Paste:=xlPasteValues
Then we'd copy the next row of data from the Data tab (i.e., range E3:G3).
This seems like a classic loop scenario, but I don't know how to write it in VBA.
You can do this on a range, I see two ways you can do it, using a copy and paste or simply replicating a transposed version of the data:
'Copy and paste method
Worksheets("Model").Range("C120:C" & range("C" & rows.count).end(xlup).row).Copy 'Using the .end(xlup) will find the last row of data without looping until blank.
Worksheets("Data").Range("H2").PasteSpecial xlPasteValues,,,True 'The True here is what tells the pastespecial to transpose
'Transpose method
Worksheets("Data").Range("H2:J2").Value = application.transpose(Worksheets("Model").range("C120:C122"))
Each have their advantage, the Copy and Paste method is easier because you don't need to know the end column so it works easier for a dynamic range, the transpose method doesn't use the clipboard so is less impact on your system.
The better method code wise would be the transpose method.
You can then set up a simple For Next loop to run through as many data ranges as you want.
Dim DataRow As Long, MyDat As Worksheet, MyModel As Worksheet
Set MyDat = Worksheets("Data")
Set MyModel = Worksheet("Model")
For DataRow = 2 To MyDat.Range("E" & Rows.Count).End(xlUp).Row
MyModel.Range("B4:D4").Value = MyDat.Range("E" & DataRow & ":G" & DataRow).value
Calculate
MyDat.Range("H" & DataRow & ":J" & DataRow).Value = Application.Transpose(MyModel.Range("C120:C122"))
Next
This is a simple loop that finds the last row in "Data" and uses it for the loop defined in "Model".
The expected result of this is that the loop will begin at row 120 and continue until the last row in "Data", copying data from C120 through to C(lRow) and pasting it into the "Data" sheet.
Sub test()
' declare your variables so vba knows what it is working with
Dim lRow, i As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim srcws As Worksheet: Set srcws = wb.Worksheets("Data")
Dim destws As Worksheet: Set destws = wb.Worksheets("Model")
' find the last row in Data
lRow = srcws.Cells(srcws.Rows.Count, 1).End(xlUp).Row
' iterate from 120 to the last row found above
For i = 120 To lRow
' copy /paste the data
srcws.cells(1, 3).Copy Destination:=destws.cells(2, 7 + i)
Next i
End Sub
Best way is to use the cells-function, where the first argument is the row and the second is the column. Since you want to inrement the source to copy from by one row at a time but increment the paste destination by one column by a time, this method will be suitable.
In addition, try to not use "copy-paste", focus on setting the value for a cell by referring to a the value attribute from the source to copy. Each time you copy and then paste into the destination, you will need an additional memory cell, resulting in a much longer elapsed time if you are working with a large range to copy.
The code below should do the job.
Sub CopyData()
Dim i As Integer
i = 8 ' Start pasting into column H
' Loop until a blank cell is found
Do While Not Selection.Value = 0
With Sheets("Data").Cells(i + 112, 3)
' Select each cell in "Data", starting on C120
.Select
' Copy the value into "Model", starting on H2
Sheets("Model").Cells(2, i).Value = .Value
End With
Loop
End Sub
So I am currently working with a List Object table on a piece of code - I have defined it as InTbl. What I want is to write a code that will look through the fourth column of said table (only going through the databody rows) and copying any values that may be on that row to the 9th column on the table.
For some reason, the code itself works for the first 12 rows (and the header for some reason), copying the values over fine and then stops?
Here is the code,then I'l explain where I think it has gone wrong?
Sub AmendMVCCY
Dim InTbl As ListObject 'Dim the input table as 'InTbl'
Dim i As Long
Dim rng As Range, AmendedCCY As Range
Set InTbl = Sheets("Input").ListObjects("INPUT")
Set AmendedCCY = InTbl.ListColumns(4).DataBodyRange
For i = 1 To AmendedCCY.Rows.Count 'For row starting as 1 to Last row within the data body
If Not IsEmpty(AmendedCCY.Cells(i, 1)) Then 'The the cell isn't empty
Cells(i, 4).Copy 'Copy the figure in amended Column
Cells(i, 9).PasteSpecial xlValues 'Paste Values in 9th Column
End If
Next i
End Sub
I think that when I have defined the ListColumn(4) it is misreading the data. Thw table is 200ish rows long and will only grow, but it seems that when I state
For i = 1 To AmendedCCY.Rows.Count
it only counts 12 rows and not the whole lot.
It is likely this is poorly worded but I'll try and make it clearer if needs be.
Essentially, I need the loop to go through the whole Listobject table, but am not sure at to why that isn't happening atm
Edit: Picture of the table (though sample of 20 rows)
Basically, in the end, I need any figures in Amended to overwrite the 9th Column (which will have monetary values in before)
Similar to FanDuru's suggestion:
Instead of:
For i = 1 To AmendedCCY.Rows.Count 'For row
If Not IsEmpty(AmendedCCY.Cells(i, 1)) Then 'The the cell isn't empty
Cells(i, 4).Copy 'Copy the figure in amended Column
Cells(i, 9).PasteSpecial xlValues 'Paste Values in 9th Column
End If
Next i
Try:
Dim lastRow as long
lastRow = AmendedCCY.Rows.Count
For i = 1 To lastRow 'For row starting as 1 to Last row within the data body
If Not IsEmpty(AmendedCCY.Cells(i, 1)) Then 'The the cell isn't empty
Cells(i, 9) = Cells(i, 4).value
End If
Next i
There's no need to use copy / paste. Make sure the table's AmendedCCY.Rows.Count is actually greater than twelve.
I'm new to VBA and this is my first post here, so please excuse my amateurish question, but how do I copy values from 2 or more columns and paste them in 1 column without overwriting the values (i.e. values pasted in a single column successively).....the columns containing the values are U,V and W to be pasted in column AB.....
Please find the code below:
Private Sub CommandButton1_Click()
Dim a As Integer
Range("u1").Select
Noofcolumns = Range(Selection, Selection.End(xlToRight)).Columns.Count
For i = 1 To Noofcolumns
Cells(1, 20 + i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
For j = 1 To 500
a = Cells(j, 28).Value
If IsEmpty(a) Then
Cells(j, 28).Select
Selection.PasteSpecial Paste:=xlPasteValues
Else: GoTo 1
End If
Next j
Next i
End Sub
Some things for you to consider:
Have a read on how to avoid the use of .Select. One of the most shared posts on SO here I think, and a great guide in better referencing Range object.
To build upon the first point, you would want to be explicit referencing Range objects. For example Range("u1").Select will select U1 on the currently active worksheet. Instead, at least, use a worksheet reference (even a workbook reference could be better)
Secondly, you have used XlToRight to retrieve the last used column. If this was your intention it might be just fine. But for future reference, if there is a gap in your data, you might end up with a Range you not happy with. XlToLeft might be better, for example the below would find the last used column in the first row from the right to the left:
With Sheet1
LastColumn = .Cells(1, sht.Columns.Count).End(xlToLeft).Column
End with
In your case such assesment might not even be needed since your values are in columns U:W, instead your can just use a For x = # to # loop.
The same counts for when you want to find a last used row. A blank cell can throw off XlDown, but XlUp will counter that. A more in depth post on finding a last row can be found here, also a highly valuable SO post. For example, the below will get the last used row from column A:
With Sheet1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End with
Another thing is that you won't need to use Copy to transfer values, you can do so directly, for example (simplified):
With Sheet1
.Cells(1, 1) = .Cells(1, 2)
End with
Another (minor) point is that there is no use in using Integer data type variables. They overflow easily if misused causing errors. You better of using Long data types.
Try and avoid Goto statemtents, this cause spaghetti code and in your case there isn't even a statement missing (goto has nowhere to actually go)
Now with those points you can try to alter your code, which now could look like the below:
Sample Data:
Sample Code:
Private Sub CommandButton1_Click()
'Dimming our variables properly
Dim lr1 As Long, lr2 As Long, x As Long
'Using an explicit sheet reference
With Sheet1
'Looping over the columns U:W
For x = 21 To 23
'Getting the last used row from the column
lr1 = .Cells(.Rows.Count, x).End(xlUp).Row
'Getting the last used row from column J
lr2 = .Cells(.Rows.Count, 28).End(xlUp).Row + 1
'Transfer data directly
.Cells(lr2, 28).Resize(lr1 - 1).Value2 = .Range(.Cells(2, x), .Cells(lr1, x)).Value2
'Continue to next column in iteration
Next x
End With
End Sub
Result:
All the above was in the assumption you have a header in all these column. If not, simply adjust accordingly.
I have written a VBA code which copies data from a pivottable into another worksheet in order to store this data.
The data is monthly and counts the amount of devices, this is needed to create a historical database.
Sub DataTransferv1()
Dim lastrow As Long, erow As Long
'Stamp from when the data set is (in months) Worksheets("Database").Select
Worksheets("Database").Range("A3").Select
If Worksheets("Database").Range("A3").Offset(1, 1) <> "" Then
Worksheets("Database").Range("A3").End(xlDown).Select
ActiveCell.FormulaR1C1 = "=NOW()"
End If
'To check the last filled line on sheet 'Database_Input' lastrow = Sheet12.Cells(Rows.Count, 1).End(xlUp).Row
'Copy Paste section For i = 2 To lastrow
Sheet12.Cells(i, 1).Copy
erow = Sheet14.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet12.Paste Destination:=Worksheets("Database").Cells(erow, 1)
Sheet12.Cells(i, 2).Copy
Sheet12.Paste Destination:=Worksheets("Database").Cells(erow, 2) Next i
End Sub
The problem with this code, it keeps paste a date stamp in the last used cell (So it overwrites the last row of copied data). How can I fix this as I don't see it anymore. Also, what VBA formula can be used for a static date stamp, in the regular excel its Shift + ; but I cant find the formula for this.
Thank you very much!
I am putting together a basic inventory control system and I would like the columns with a time-stamp in the "Checked-Out" column to be pasted into a list on another worksheet. I have successfully copied the correct entire rows, but I would like this to just copy and paste the table rows instead because I have instructions listed in column A that are not relevant for the compiled list. I am new to VBA coding, thanks in advance!
I have named ranges for the two tables called "Inventory_List": Inventory!$I$3:$N$1048576 and "Checked_Out": CheckedOut!$B$3:$G$1048576 as the copy/paste ranges respectively.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 1000 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("N").Column).Value > 0 Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("CheckedOut").Select
Rows(pasteRowIndex + 5).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Inventory").Select
End If
Next r
End Sub
When I try to reference ranges instead of entire rows, I get "run-time error 1004" because my copy area and paste area aren't the same size, but I am a bit confused because my ranges seem to be the same size. I am pretty sure this is because I am adding the ranges to the incorrect portion of the code.
Copying and pasting of Excel ranges is quite standard, if you take into account 2 things:
Refer to the ranges correctly with the upper left cell and the lower right cell;
Always, refer to the Parent worksheet.
In the code below, the upper left cell and the lower right cells of the copied and pasted ranges are like this:
.Range(.Cells(count, 1), .Cells(count, "C"))
copyTo.Range(copyTo.Cells(count, 1), copyTo.Cells(count, "C"))
The parent worksheets are always referred. With with for the copyFrom and with explicit writing for copyTo.
Sub TestMe()
Dim copyFrom As Worksheet
Dim copyTo As Worksheet
Set copyFrom = Worksheets(1) 'Or better write the name - Worksheets("CheckedOut")
Set copyTo = Worksheets(2)
Dim count As Long
For count = 1 To 30
With copyFrom
If .Cells("N", count) > 0 Then
.Range(.Cells(count, 1), .Cells(count, "C")).Copy Destination:=copyTo.Range(copyTo.Cells(count, 1), copyTo.Cells(count, "C"))
End If
End With
Next
End Sub
Last, but not least - this is a must read for VBA - How to avoid using Select in Excel VBA