Work FIle
Hello,
I have spend days trying to figure out a solution and I have exhausted my knowledge. I would give my current code but there isn't one since all 500 didn't work.
I want to convert the formulas to values after they have been populated or by the row value P7W2 which changes every week and is located at C1. The values are located in Column D but I want to paste from columns E to Q based on the row value.
I don't think the copy and paste method work because it seems it has to paste in another place but I am just looking to convert these formulas to rows.
Can anyone provide insight into what is my best option?
Attempt 1
Public Sub CopyRows()
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column D
ThisValue = Cells(1, 3).Value
If ThisValue = Range("D") Then
Cells(x, 5).Resize(1, 18).copy
Cells(ThisValue, 1).Select
ActiveSheet.Paste
NextRow = Cells(Rows.Count, 1).End(xlUp).Row
End If
Next x
End Sub
Attempt 2
Sub Button1_Click()
Worksheets("Item Class Data").Activate
Range("C1").Select
ActiveSheet.End(xlDown)).Select
ActiveCell.Value = ActiveCell.Value
End Sub
Related
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 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.
I am trying to do the following in Excel:
The easiest way is of course to just drag and drop, but as I have many rows and columns, this is not feasible.
I was thus thinking that the following should work:
=IF(B6="Food", "Food", "insert two blank cells")
However, to my surprise, I was unable to find seomthing which would allow me to actually use "insert shift cells down" in a formula. What do I overlook, do I need to get started with VBA here?
Thanks!
I believe the following code would do what you expect:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your Sheet above
lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'find the last row with data on Column A
For i = 6 To lastrow 'loop from row 6 to last
If ws.Cells(i, 1).Value = "Food" Then 'if Food is found
ws.Cells(i, 2).Insert Shift:=xlDown 'insert a blank cell on Column B
ws.Cells(i, 2).Insert Shift:=xlDown 'again insert a second blank cell on Column B
End If
Next i
End Sub
I am trying to write a VBA macro for Excel that will go down one column and compare one cell to the previous cell to see if they are the same or not. If they are the same I want it to do nothing and continue on down the column. If they are not the same then I want to copy multiple columns in that row and paste them in a separate tab or spreadsheet.
Basically my data is a list of pressures taken every two seconds and I have thousands of data points. I want to export only the pressure and elapsed time so that I have a much smaller set of data that is more useful. Basically I want to clean up my data to only show changes in pressure and the times at which the pressures change.
I was able to figure out a macro that works.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 3725 ' 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("C").Column).Value <> Cells(r + 1, Columns("C").Column).Value Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).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("Sheet1").Select
End If
Next r
End Sub
Hope this helps. Mark as answered if this helps!
Sub compare()(
for I = 2 to Sheets("Sheet1").Cells(Rows.Count,"A").End(xlup).Row
If Sheets("Sheet1").Range("A" & I)<>Sheets("Sheet1").Range("A" & I-1) then
'move data
For j = 1 to rows
For k = 1 to columns
Sheets("Sheet2").cells(j,k)=Sheets("Sheet1").cells(j,k)
Sheets("Sheet3").cells(j,k)=Sheets("Sheet1").cells(j,k)
Next k
Next j
End if
Next I
End Sub