I have a table with 15 columns. I'm trying to copy and paste 3 of the columns into another sheet and then duplicate that info below itself in the destination sheet a specified number of times based on the number layers in the test I'm conducting. I'm having trouble with the code finding the bottom row of the copied data and I haven't found code that will eliminate the gaps in the data.
this is my first post so I cant add pictures yet.
here's my current code for the button that is supposed to populate the destination sheet:
Private Sub PRTButton_Click()
CopyInfo
PasteInfo
End Sub
Sub CopyInfo()
Dim aLastRow As Long
aLastRow = Sheets("Test Ammo").Cells(Rows.Count, 1).End(xlUp).Row
'ammo description
Sheets("PRT Endurance").Range("B6:B" & aLastRow - 1).Value = Sheets("Test Ammo").Range("O64:O113" & aLastRow).Value
'Ammo Spec
Sheets("PRT Endurance").Range("C6:C" & aLastRow - 1).Value = Sheets("Test Ammo").Range("C64:c113" & aLastRow).Value
'QTY Shot
Sheets("PRT Endurance").Range("D6:D" & aLastRow - 1).Value = Sheets("Test Ammo").Range("N64:N113" & aLastRow).Value
End Sub
Sub PasteInfo()
Dim LRow As Long
With ActiveSheet
LRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Range("B6:D" & LRow).Copy
MsgBox "Info is already in clipboard. Select your layers from the dropdown and paste at the bottom of the copied info for each layer."
End Sub
I know i haven't told the code to only copy the values with a number in the M column and paste them into the destination sheet. for reference, I only want to copy the rows that have a value in the M column in my origin sheet. I'm not sure how to tell the code to select the 3 row dynamic range in the destination sheet and paste it a certain amount of times below it.
If I missed any explanations or there's any confusion, let me know and I'll try to clarify.
Origin table
Table after pressing "Populate ammo info"
The following code works but runs too slowly on large files, so the code needs to be modified to identify the first year that is earlier than 2019 and then delete that row and the row containing the rest of the years below that, all at one time:
Range("B2").Select
Do Until ActiveCell.Value =""
If ActiveCell.Value < 2019 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1,0).Select
End If
Loop
Code Problem: data sets can have 1000's of rows so checking every cell is very slow. Since the data is always in order, all I need to do is find the first entry <2019 and then select xldown and delete everything, but I don't know how to find that cell and make it the active cell.
as stated in the comments:
Dim firstrow As Variant
firstrow = Application.Match(2018, ActiveSheet.Range("B:B"), -1)
If Not IsError(firstrow) Then
Dim lastrow As Long
lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row
ActiveSheet.Rows(firstrow + 1 & ":" & lastrow).Delete
End If
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 completely new to VBA, so this task is a bit difficult for me but I bet it is easy for you guys.
I am trying to create a macro command that can automatically convert a series of dates from text to a date format that excel can recognize. This is a task which I regularly perform, so it would be very time saving to have a macro doing it for me.
Basically, I regularly download a time series of e.g. the historical price of a stock. The length of the time series varies every time.
Next I will need to convert the dates from the downloaded data to a format excel can recognize.
To do so I use the following code:
=DATE(RIGHT(B2,4),MONTH("1 "&MID(B2,4,3)),LEFT(B2,2))
in the cell adjacent to the first row of the date series.
I then auto-fill this formula to the end of the series.
I have created a macro that performs this task for me, using the following code:
Sub FacsetDates()
' FacsetDates Macro
' Turn Factset dates into excel format
'
' Keyboard Shortcut: Ctrl+Shift+D
ActiveCell.FormulaR1C1 = _
"=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
Selection.End(xlToLeft).Select
Dim Lastrow As Long
Lastrow = Cells(Rows.Count - 1, ActiveCell.Column).End(xlUp).Row
Selection.End(xlToRight).Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & Lastrow - 1)
ActiveCell.Range("A1:A" & Lastrow - 1).Select
End Sub
My problem is that this code only works if the date series start from row 2.
If the the series is inserted from row 1 the auto-fill will stop one row short and if the series start from row 3, the auto-fill will fill out one row too much (compared to the length of the data series)
I would like a macro that works no matter which row the data series start.
E.g. I would like the macro to work even if the date series begin at B10.
I imagine that the solution is to set the data series as an array in VBA and then perform a loop that manipulate each string of text, and then finally paste the manipulated data in the adjacent column.
I have started producing the following code:
Sub FSdate()
Dim arrMarks() As Long
Lastrow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
ReDim arrMarks(1 To Lastrow)
Dim i As Long
For i = LBound(arrMarks) To UBound(arrMarks)
arrMarks(i) = ActiveCell
Next i
In which I try to first define the array and its size, and then "copy" the string of text from the active cell (being the first row of the data series), but this code fails.
After having defined the array, I imagined to run a loop that use the DATE function from above to manipulate every single entry in the array. But my current skills in VBA falls short here, and I simply do not know how to proceed.
Can anyone help create such a code?
or even, do you guys have inputs to alternative ways of doing this task?
Probably the initial code can be manipulated to work no matter which row the data series start.
I hope somebody is able and willing to help me!
This is a vary simplified breakdown of #Dave answer, since you want to use the cell you are selecting to start from. First; set your last row by counting the rows in the column to the left from your active cell. Second; set your range from the active cell to the last row variable. Third: write your formula into the range. Note: the lRow - ActiveCell.Row + 1 adjusts your range based on the activecell row number.
Dim lRow As Long
lRow = Cells(Rows.Count, ActiveCell.Offset(, -1).Column).End(xlUp).Row
ActiveCell.Resize(lRow - ActiveCell.Row + 1).FormulaR1C1 = "=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
An easier way to accomplish your task; by overwriting the current text would be to use TextToColumns
ActiveSheet.Columns("F").TextToColumns Destination:=ActiveSheet.Columns("F"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 3), TrailingMinusNumbers:=True
Columns("F").NumberFormat = "m/d/yyyy"
If we first look at what's happening:
Sub FacsetDates()
' FacsetDates Macro
' Turn Factset dates into excel format
'
' Keyboard Shortcut: Ctrl+Shift+D
' Enter Formula in the current cell
ActiveCell.FormulaR1C1 = _
"=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
' Move to the leftmost cell in a contiguous range from the current cell
Selection.End(xlToLeft).Select
Dim Lastrow As Long
' Get the row number of the bottom cell in the same column as the now selected cell
Lastrow = Cells(Rows.Count - 1, ActiveCell.Column).End(xlUp).Row
' Move to the rightmost cell in a contiguous range from the now selected cell
Selection.End(xlToRight).Select
' Fill down from the current cell by the same number of cells in the range from A1 to the last row
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & Lastrow - 1)
ActiveCell.Range("A1:A" & Lastrow - 1).Select
End Sub
Where your issue with the range comes in is that ActiveCell.Range("A1:A" & Lastrow - 1) does not refer to rows 1 to x in the sheet, it refers to rows 1 to x in your range which starts at row 2 or 3 or whatever.
You will also learn very quickly that changing selections in code is time/resource consuming and is susceptible to bugs creeping in eg if selections change during the running of your code.
I would consider hardcoding the column where you are outputting your formula if it is always going to be the same to and to avoid making selections. You can do this and input the formula directly into column C like so:
Sub FacsetDates2()
Dim Lastrow As Long
' Get the row number of the bottom cell in column A
Lastrow = Cells(Rows.Count - 1, 1).End(xlUp).Row
Range("C2:C" & Lastrow).FormulaR1C1 = "=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
End Sub
EDIT -
Using the active cell and going to the end of the range as defined in column A you could use this:
Sub FacsetDates2()
Dim Lastrow As Long
Dim c As Range
Dim currentRow As Long
Dim currentColumn As String
' Store a reference to the active cell
Set c = ActiveCell
' Get the row number and column name of the active cell
currentRow = c.Row
currentColumn = Replace(c.Address, currentRow, "")
' Get the row number of the bottom cell in column A
Lastrow = Cells(Rows.Count - 1, 1).End(xlUp).Row
Range(c.Address & ":" & currentColumn & Lastrow).FormulaR1C1 = "=+DATE(RIGHT(RC[-1],4),MONTH(""1 ""&MID(RC[-1],4,3)),LEFT(RC[-1],2))"
End Sub
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