I need to copy new data from a sheet every week to an already existing sheet having all the past data. The Existing sheet columns(some) are also formulated using Vba. I have written the code which copies the data in to the sheet but the other columns are not filled up(or dragged) automatically.
Sub Transfernewdata()
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Sheet2")
lastrow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Range("D5:D" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 4)
Range("C5:C" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 3)
Range("B5:B" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 2)
Range("A5:A" & lastrow).Copy ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 1)
ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0) = Date
Application.CutCopyMode = False
End Sub
I just transfer 4 columns and rest are to be filled up automatically. I try to put the date(last line of code) but even that doesn't fill up more than once. Any help is appreciated, also I don't understand that every module I run does not affect the new data added.
change this:
ThisWorkbook.Worksheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0) = Date
to this:
ThisWorkbook.Worksheets("Sheet1").Range("A" & lastrow & ":a65536") = Date
Based on the additional information you provided in the comments, below, I would suggest making your data into a table. The formulas should automatically copy themselves every time you insert a row into the table.
If you move your cursor to the top left corner of your data set then press Ctrl-T it will automatically tabelize all the contiguous data you already have there. (You'll have to tick or untick the 'My data has headers' question, as appropriate.)
Related
I'm a beginner so bear with me
The code I'm using now is this, given to me by user "Xabier", slightly edited by me. This copies the rows with a certain document# into a separate sheet, thus giving me a list:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("test")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:=Worksheets("test").Cells(1, 26).Value
ws.Range("A2:N2" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
wsDestination.Range("A" & DestinationRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
End Sub
Now what I want to do is create something like a header for the document containing data regarding the origin of the imports.
This data is the "Import#", "Invoice#", "Supplier" and "Invoice date". Basically for every unique Invoice# I need to create a unique entry even if the supplier or the import# is the same.
And I can't copy the entire row, I just need to copy certain cells in each row.
After I actually figure out how all this works, this is how the document is going to look.
this is actually a pretty involved solution that StackOverflow is not meant for. Instead, i'll give you an idea of how you could implement this yourself.
loop through filtered data
if not first loop, check if the previous new sheet's invoice number matches this one
check that new sheet is not too full to add invoice
copy this row's invoice information to new sheet
looping through filtered data
copying data from cell to cell
I basically want to extract the years, the months and the days from the corresponding columns and use them to create an excel formatted date column with VBA.
With screenshots, it should at first look like this:
Excel Spreadsheet with Year Column and Date Column.
Whereas, ultimately, the year column should be removed with only the date column remaining (leaving aside the description) and containing the excel formatted dates. Excel Spreadsheet with Date Column only
Now, there might be an easier way to accomplish this task but the method I've undertaken is to:
Insert two new columns to the right of the Date column
Select the Date column and move over the months to the newly created column on the right by using the Text to Columns function
Format the blank 2nd newly created column to the Date category
Insert the date function into the cells of this blank column and autofill it to the cells below. More precisely, this date function is: =DATE(A2,MONTH(1&C2),B2)
Copy this New Date Column and paste it back as values only for later purposes of sorting.
Delete all other useless columns (year,month,day)
Though this is feasible with the excel interface, I'd like to accomplish this task with VBA and so I've already written quite a bit of code. Unfortunately, being a novice in VBA, I'm currently stuck at applying the formula at the final date column.
Before you take a look at my code, I'd also like to point out that I prompt the user to select the Description column as a reference column as it isn't always the case that the the year column is the first column or that the date column is the 2nd one. What is absolutely certain, however, is that to the left of the Description column, there is, respectively, the date and the year column.
Finally, if someone would also ameliorate my VBA code by solely allowing the formula to be applied to the first and last rows containing years or dates (same thing), I'd appreciate it.
I thank you all in advance.
Here below is my code
Sub Macro1()
'Set variables
Dim DescRng As Range
Dim DayRng As Range
Dim MonthRng As Range
Dim YearRng As Range
Dim DateRng As Variant
'Obtain reference column with prompt
Set DescRng = Application.InputBox("Select Description Column", "Obtain Object Range", Type:=8)
'Create new columns from reference column
Columns(DescRng.Column).Insert Shift:=x1ToLeft
Columns(DescRng.Column).Insert Shift:=x1ToLeft
'Assign variables to columns
Set DateRng = DescRng.Offset(rowOffset:=0, columnOffset:=-1)
Set MonthRng = DescRng.Offset(rowOffset:=0, columnOffset:=-2)
Set DayRng = DescRng.Offset(rowOffset:=0, columnOffset:=-3)
Set YearRng = DescRng.Offset(rowOffset:=0, columnOffset:=-4)
'Seperate the days from the months with TextToColumns
Columns(DayRng.Column).TextToColumns Destination:=DayRng, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'Format the DateRng column for later sorting use
Columns(DateRng.Column).NumberFormat = "yyyy-mm-dd"
'Apply Formula to DateRng Column
'Copy Formula in DateRng and paste into the same column as values
Columns(DateRng.Column).Copy
Columns(DateRng.Column).PasteSpecial Paste:=xlPasteValues, SkipBlanks _
:=False, Transpose:=False
'Delete the other Columns (YearRng, MonthRng, DayRng)
YearRng.Delete
DayRng.Delete
MonthRng.Delete
End Sub
Edit: I'm grateful for the insight your answers have brought. You've made possible a simple task with a short code, unlike my unfinished one. Learned a lot from my first post. Thanks
Try creating a valid string date with the displayed values from columns A and B.
with worksheets("sheet1")
for i=2 to .cells(rows.count, 1).end(xlup).row
.cells(i, 1) = datevalue(.cells(i, 2).text & ", " & .cells(i, 1).text)
.cells(i, 1).numberformat = "yyyy-mm-dd"
next i
.columns(2).entirecolumn.delete
.cells(1, 1) = "date"
end with
I took a different approach than #Jeeped so I figured i'd share since I took the time to practice with your question anyway. You will just need to format Col A with desired date format.
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim DayMonth As Variant
ws.Columns("A:A").Insert: ws.Range("A1") = "Date"
For i = 2 To ws.Range("B" & ws.Rows.Count).End(xlUp).Row
DayMonth = Split(ws.Range("C" & i), Chr(32))
ws.Range("A" & i) = DateValue(DayMonth(0) & Chr(32) & Month(1 & DayMonth(0)) & Chr(32) & ws.Range("B" & i) & Chr(32))
Next i
ws.Columns("A:A").AutoFit
ws.Columns("B:C").Delete
I apologise for the ambiguity in the question/statement but its easier to explain my issue.
I have a tool that I use to process some data in one sheet of my workbook (sheet1). And a data sheet that provides that data (sheet2)
Basically I want to take each value from Y2:LastRow of the datasheet (sheet2) run that value through the tool in sheet1 then copy that result and paste it into the same row but a different column (AQ to be exact).
Here is what I have tried so far:
With Worksheets("DataSheet")
LastRow = .Range("Y" & .Rows.Count).End(xlUp).row
For Each cell In Worksheets("DataSheet").Range(Cells(LastRow, 25), Cells(1, 25))
ThisWorkbook.Worksheets("Conversion Tool").Range("A1").Value = cell
Sheet1.Range("F14").Copy
Sheet2.Range(Cells(LastRow, 43), Cells(2, 43)).PasteSpecial (xlPasteValues)
Next
End With
However, with this is pastes the value into all cells of that column. I know that there is probably some basic fix but I'm still getting to grips with this.
Thanks in advance.
This should work for you
With Worksheets("DataSheet")
LastRow = .Range("Y" & .Rows.Count).End(xlUp).Row
For Each Cell In .Range(Cells(LastRow, 25), Cells(1, 25))
ThisWorkbook.Worksheets("Conversion Tool").Range("A1").Value = Cell
Sheet1.Range("F14").Copy
.Range("AQ" & Cell.Row).PasteSpecial xlPasteValues
Next
End With
It takes the row from the cell you copied and enters the new value in same row but column AQ.
I have two sheets of data. The first sheet is imported data that will show total users to my site from the day before. The second sheet is a table with all historical data from those daily reports. I'd like to automate a way to copy the data from my first sheet (that data will always be in the same cell) to a new row at the bottom of my existing table. Here's what I have:
Sub Insert_New_Rows()
Dim Lr As Integer
Lr = Range("AF" & Rows.Count).End(xlUp).Row
Rows(Lr + 1).Insert Shift:=xlDown
Cells(Lr + 1, "AF") = Cells(Lr, "AF") + 1
Sheets("Day Before").Range("$A$12:$B$12").Copy
Sheets("Historical").Cells(Lr + 1, "AF").Paste
Application.CutCopyMode = False
End Sub
In this, you'll see that my table is in columns AF and AG. When I run this macro, it only adds a row, it does not copy and paste the information.
I am not really sure where your table starts on the sheet "Day Before". So, I am assuming that it starts in row 1. Based on this assumption here is a little revision to your code:
Option Explicit
Sub Insert_New_Rows()
Dim lngNextEmptyRow As Long
Dim lngLastImportRow As Long
Dim shtYstrdy As Worksheet
Set shtYstrdy = ThisWorkbook.Worksheets("Day Before")
With ThisWorkbook.Worksheets("Historical")
lngNextEmptyRow = .Cells(.Rows.Count, "AF").End(xlUp).Row + 1
.Rows(lngNextEmptyRow).Insert Shift:=xlDown
.Cells(lngNextEmptyRow, "AF").Value2 = _
.Cells(lngNextEmptyRow - 1, "AF").Value2 + 1
lngLastImportRow = shtYstrdy.Cells(shtYstrdy.Rows.Count, "A").End(xlUp).Row
shtYstrdy.Range("A1:B" & lngLastImportRow).Copy _
Destination:=.Cells(lngNextEmptyRow, "AF")
End With
End Sub
Changes:
Explicit coding as suggested by #findwindow stating the workbook and the sheet before each Range, Cells, reference.
Copy and paste in one line of code (before three lines of code).
Using lngNextEmptyRow instead of LastRow so be can skip all these +1.
Determine the size (last row) of the table on the sheet "Day Before", so we know how much we need to copy over.
I hope this is the answer you've been looking for. Let me know if I misunderstood something or if anything requires more explanations.
There is no need to Active or Select Ranges. It is best to work with the Ranges directly. Rarely should you use ActiveCell, ActiveWorkSheet, or Selection.
This is how Copy and Paste work
Here is the shorthand for Copy and Paste
Range(SourceRange).Copy Range(DestinationRange)
Know that this will work for you:
Sheets("Day Before").Range("$A$12:$B$12").Copy Sheets("Historical").Cells(Rows.Count, "AF").End(xlUp).Offset(1)
I have a database that is growing quite large. Every day I add about 100 rows of information.
I have about 20 columns that autofill with calculations, etc. A few of those columns pull from a VERY large file using Vlookups. That takes forever because it's pulling the entire column everyday because my current autofill macro starts in row 2.
Is there any way to write the macro so that it autofills from the previous "last row" so it's only autofilling 100 or so new rows instead of several thousand?
I have tried the following with no luck:
Range("BZ2").AutoFill Destination:=Range("BZ2:BZ" & LastRow) is an example of one of my VBA codes for an autofill I use. LastRow is the last row after the new data is pasted in. I would like it to ideally start at the OldLastRow which would be the last row before I paste in the new data. I tried Range("BZ" & OldLastRow).AutoFill Destination:=Range("BZ" & OldLastRow & ":BZ" & LastRow) without luck.
Try this.
Dim LastRow As Long
With ActiveSheet
'This will get you the OldLastRow. Add +1 to the end to get the first empty row if you need it.
'The "A" in .Rows.Count, "A" should be replaced with a column that will always have data in every row.
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("BZ2").AutoFill Destination:=Range("BZ2:BZ" & LastRow)
'This will pause the macro until Calculations are complete.
Do While Application.CalculationState <> xlDone
DoEvents
Loop
End With
Ideally you would be doing the autofill from the point that you pasted your data in, so you wouldnt want to have "BZ2" anywhere in there if you just want to autofill new data.
you could try this one as well.
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "BZ").End(xlUp).Row
.Range("BZ2").AutoFill Destination:=Range("BZ" & LastRow & ":BZ" & Cells(Rows.Count, "BY").End(xlUp).Row)
Do While Application.CalculationState <> xlDone
DoEvents
Loop
End With
This is assuming you only have one column of calculations. if not change the "BZ" & LastRow & ":BZ" to "BZ" & LastRow & ":CA" or whatever your last calculated column is.