I have 3 columns of data with the first column being dates in m/dd/yyyy format and the other two columns not relevant to the question. What I want to do is write code for a command box or macro that will copy the entire range of date only up to a certain year, 1996 (the dates in column A are in chronological order from 1986 - 2017). Then I would like this portion of the data in the range to be pasted into another worksheet in the workbook. How would I go about this?
You can loop through every item in the column while the year is less then 1996 to find the last row-index and then select/copy the entire range.
For example:
Sub sample()
Dim idx As Integer
idx = 1
Do While Year(Cells(idx, 1).Value) < 1996
idx = idx + 1
Loop
Range(Cells(1, 1), Cells(idx - 1, 3)).Copy
Sheets("name of worksheet").Range("first cell of range you'd like to paste into").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Related
I work for a local company that uses antiquated systems relying on much manual data entry. Trying to ease the pain with some faster capabilities using excel vba and formulas. I've built a spreadsheet filled with formulas and vba buttons. I'm literally on the last part and have been stuck now for at least 2 weeks. Time is now running out and I'm hoping for some assistance.
Spreadsheet has 2 sheets named "Sheet1" and "Sheet2". On Sheet1 I use a button to concatenate and move data into one cell which is L11. In L8 I have a constant changing date, day by day. The data entry works like this: I enter data for April 11th and then change the date in L8 to April 14th (could be any day, just using 14 as an example) to enter the next set of data. On Sheet2 I have each column labeled by days in the month, i.e. Column A = 1-Apr, Column B = 2-Apr, Column C = 3-Apr, etc.... to the end of the month 30 or 31 which equals Column AD or AE.
What I'd like for the code to do is move the data from cell L11 on sheet1, based on the date in L8 on sheet1, the data moves from sheet1 to sheet2 under the corresponding date. So the click of a button, the macro/vba code finds the date on sheet2 and looks for the date in L8 sheet1 and says:
"I see a date of 17-Apr in L8, what data exists in cell L11 on sheet1? Ahhh ok.. there is data in L11 sheet1. I will go ahead and take that data from L11 and paste it in column 17(column Q) in the next available slot below. Then I will make sure the data is removed from Sheet1 and put the user back on Sheet1 ready to be used again."
Please keep in mind that the data that exists in L8 sheet1 (the date) contains a vlookup formula. If that is not needed, I'll gladly take other ideas on matching dates. Or for that matter any other ideas that are better than what you see above and below I'm always open to suggestions. Also, the button I use to concatenate data that ultimately ends up in cell L11 sheet1 is a recorded macro. Basically I recorded copying specific cells and pasting them together in one cell and then inserted a single cell that pushes the concatenated data down one cell so that I could enter more than one set of data.
This is the most recent code I've been working on. When I used the loops for i and j, the code did not error out, however it didn't do anything when running. I recently tried adding k and m, but the wall I'm hitting just won't budge. Help please...
Sub senddatatosheet2()
Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim mydate As String
lastrow1 = Sheets("sheet1").Range("L" & Rows.Count).End(xlUp).Row
For i = 8 To 8
For k = 11 To 11
mydate = Sheets("sheet1").Cells(i, "L").Value
Sheets("Sheet2").Activate
lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To lastrow2
For m = 2 To lastrow2
If Sheets("sheet2").Range(Cells(j, "A")).Value = mydate Then
Sheets("Sheet1").Activate
Sheets("Sheet1").Range(Cells(11, "L")).Copy
Sheets("Sheet2").Activate
Sheets("Sheet2").Range(Cells(j, "A"), Cells(j, "AD")).Select
ActiveSheet.Paste
End If
Next j
Next m
Application.CutCopyMode = False
Next i
Next k
Sheets("Sheet1").Activate
Sheets("sheet1").Range("A1").Select
End Sub
Correct me if I'm wrong...
You enter the date in Sheet1!L8, then enter whatever data you want into whatever cells you do, which is all concatenated into Sheet1!L11.
You want to transfer the data in Sheet1!L11 into say Sheet1!xy (where x=the column for the data to go into for that day and y=the next empty row), who's date is in Sheet1!x1 and it matches the date in Sheet1!L8
If so, the following should do:
Sub btnNext_Click()
Dim MyDate As Date
Dim ColFound As Long, NextRowToUse As Long, MyData As String
Dim RowThatContainsDates As Long
'Enter the row that contains the dates across the top
RowThatContainsDates = 1
'Get the date from Sheet1!L8
MyDate = Sheets("sheet1").Cells(8, 12).Value
'Get the data from Sheet1!L11
MyData = Worksheets("Sheet1").Cells(11, 12).Value
'Get the column where the date in Sheet1!L8 is found
ColFound = Worksheets("sheet2").Rows(RowThatContainsDates).Find(MyDate, LookIn:=xlFormulas, LookAt:=xlWhole).Column
'Get the next row to use for the selected Column
NextRowToUse = 1
Do While Worksheets("sheet2").Cells(NextRowToUse, ColFound).Value <> ""
NextRowToUse = NextRowToUse + 1
Loop
'Duplicate the text from Sheet1!l1 to the Row and Column found
Worksheets("Sheet2").Cells(NextRowToUse, ColFound).Value = MyData
'Clear the contents of the cells containing the original data
Worksheets("Sheet1").Range("L3:L6").ClearContents
End Sub
At the end of every month, we copy/paste forecast sales (where the formulas are) as a hardcode into other columns for reference and reconciliation purposes.
For example, copy Column D (January) through Column F (march) into column Q (Jan hardcoded) through S (March hardcoded)
I'm trying to modify my code so the user can select from two data validation dropdowns which month range (e.g. Jan - Mar) on each of the forecast tabs to copy/paste as values.
For example, below is something I've added to copy/paste based on the # rows for a formula.
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("T1") = "PPU"
Range("T2") = "=S2/R2"
Range("T2").Copy
Range("T2:T" & LastRow).Select `dynamic row
Selection.PasteSpecial xlFormulas
Range("T:T").Copy
Range("T:T").PasteSpecial xlPasteValues
With my code above, is it possible to alter this so, instead of " & Lastrow", I keep the rows static but make the columns to copy variable, so for lack of a better term firstMonth & secondMonth.
The columns to select would be based off two named ranges where the user chooses from two data validation lists (firstMonth & secondMonth) with each column being assigned a column "letter" (e.g. Jan is column D, Feb Column E, etc.)
Without being dynamic, it would be something like:
Range("D12:F19").Copy
Range("Q12").PasteSpecial xlValues
But I'd like to have the user select with months, via a data validation list, to have hardcoded by choosing a beginning month (firstMonth) and ending month (secondMonth)
Something along the lines of:
Range(firstMonth &"12": secondMonth & "19").Copy `firstMonth in theory is the column letter so, "D12" and secondMonth is the second column letter (F12)
Range("pasteFirstMonth &"12").PasteSpecial xlValues `the firstMonth will be paired with the column letter, say "Q" where it will paste those values. A second column range isn't needed here since only the copied range will paste, not overlapping anything else. This is the "hardcoded" area.
Update: Slightly reconfigured Tim's answer below.
Sub copyColumns()
Dim months, m1, m2, sht
months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")
Set sht = ActiveSheet
m1 = Application.Match(sht.Range("Month1").Value, months, 0)
m2 = Application.Match(sht.Range("Month2").Value, months, 0)
sht.Range(sht.Cells(8, 3 + m1), sht.Cells(16, 3 + m2)).Copy
sht.Range(sht.Cells(8, 16 + m1), sht.Cells(16, 16 + m2)).PasteSpecial xlValues
End Sub
Something like this should work:
Sub DoCopy()
Dim months, m1, m2, sht
months = Split("Jan,Feb,Mar,Apr,May,June,July,Aug,Sept,Oct,Nov,Dec", ",")
Set sht = ActiveSheet
m1 = Application.Match(sht.Range("Month1").Value, months, 0)
m2 = Application.Match(sht.Range("Month2").Value, months, 0)
If Not IsError(m1) And Not IsError(m2) Then
'copy range - use offset (3 here) depending on where months begin
sht.Range(sht.Cells(12, 3 + m1), sht.Cells(19, 3 + m2)).Copy
'etc
End If
End Sub
You can prompt the user for selecting the desired months and you can use the Selection object, like
Set rng=Selection
Cells(rng.row, rng.column) gives you the top left cell of the selection,
rng.Columns.Count gives you the number of columns, etc.
From a users perpective it is much easier to select an area on the screen and press a button than entering values or selecting them from list.
I have a Macro that takes data out of 2 reports.
in the second report I have dates that I copy. I need to take a date and subtract from it 14 days
I go to first blank cell in column D, then I want to calculate the formula in column C and scroll down without type how many cells (because it is a macro to a daily basis and the amount of data will change). I want to do this until the end of the data I copied.
In the end I want to copy it as values to column B.
Here is what I have in my code(part of all macro):
'first we go to the buttom of the column
'for NOW - change manually the top of the range you paste to
'Now, paste to OP_wb workbook:
OP_wb.Sheets("Optic Main").Range("D1").End(xlDown).Offset(1, 0).PasteSpecial
Paste:=xlPasteValues
' Calculate Due Date to MFG tools
' it means date we copied from MFG daily minus 14 days
_wb.Sheets("Optic Main").Activate
Range("C1").End(xlDown).Offset(1, 0).Activate
ActiveCell.FormulaR1C1 = "=RC[1]-14"enter code here
You need to loop from the first row to the last row. In general, there are plenty of good ways to define the last row of a given column. Once you have done it, replace the value of lngEndRow and run the following code:
Option Explicit
Public Sub TestMe()
Dim lngStartRow As Long: lngStartRow = 1
Dim lngEndRow As Long: lngEndRow = 100
Dim rngMyRange As Range
Dim rngMyCell As Range
With ActiveSheet
Set rngMyRange = .Range(.Cells(lngStartRow, 5), .Cells(lngEndRow, 5))
End With
For Each rngMyCell In rngMyRange
rngMyCell.FormulaR1C1 = "=RC[1]-14"
Next rngMyCell
End Sub
Then change the ActiveSheet with the correct sheet and the column hardcoded as 5 with the correct one. Run the code above in an empty Excel, to understand what it does. Then change it a bit, until it matches your needs.
I have a workbook with 2 sheets that contain some of the same data. The first column in both worksheets contain a number assigned to an item, but sheet 2 contains more items
than sheet 1. Sheet 1 contains the items pertinent to me, so I am trying to copy the relevant data from sheet 2 into sheet 1.
For example:
Sheet 1
Column A
20
53
120
500
1123
etc
Sheet 2
Column A
1
2
3
4
5
etc
If the number in column A matches for both spreadsheets, I need to copy cell M from sheet 2 to cell I in sheet 1. I have tried a few different solutions posted elsewhere, but
since my data isn't ideally sorted between the two sheets, using things like VLookup wasn't working well.
I believe I need to store the information in column A in both sheets to an array and compare the data from there, I just have no clue how to write the code to continue
comparing the cell from sheet 1 until it finds a match in sheet 2, and then copy the data over.
Any help I can get would be greatly appreciated. Thanks everyone.
My current code:
Sub CopyFromSheet2()
Dim i As Long
Dim j As Long
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Sheets("Sheet1").Range("A:A")
Set Range2 = Sheets("Sheet2").Range("A:A")
For j = 1 To Range1
For I = 1 To Range2
If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
Sheets("Sheet1").Cells(i,"I").Value = Sheets("Sheet2").Cells(j, "M").Value
End If
Next i
Next j
End Sub
I am currently getting run time error 13 on the For j = 1 to Range1 line "Type mismatch"
Something to start with would be a loop from row 1 to last row in sheet 1, then for each of these rows, compare value of cell 1 to each value in sheet 2.
A way to compare them to each other would be like this:
If Sheets("sheet 1").Cells(i, "A").Value = Sheets("sheet 2").Cells(j, "A").Value Then
now you just need to put a nested loop around this and you are good to go.
To copy column m to i:
Sheets("sheet 1").Cells(i, "I").Value = Sheets("sheet 2").Cells(j, "M").Value
Now try out something and feel free to ask again if you are running into an error
So I ended up consolidating the columns I need into 1 spreadsheet to make things easier, and I found this question on SO: Comparing two columns, and returning a specific adjacent cell in Excel which was very similar to what I was trying to do. The formula
=IFERROR(VLOOKUP(C1, A:B, 2, 0), "")
worked perfectly for me, so I am using that instead of the VBA scrip.
I have 20 sheets (let's say three, for simplicity) and I need to sumif each of those sheets against one main tab with all the data in it. Each sheet is for a different business entity but each sheet has the same format:
Format: Business 1000
Format: Business 2000
I will insert monthly data into the DATA tab and will need a macro to go into Sheet 1, 2, 3 etc. and run a sumif against the DATA tab matching column B (business unit code). I will also have this run for each month so Row3 will have Actual or Forecast.
The problem:
DATA tab gets deleted and reset with next month's data, therefore all sumifs must change into values.
not all rows are equal, some may have 5-6 items and then a Sum for the total, eg: travel may include hotel, parking, meals, car rental. So SumIF can only run where column B has a code. Otherwise do NOTHING.
I don't know how to code a relative reference inside sumif. I can VBA code a column and tell it to enter "Text" into each non-blank cell. Although I can't tell it to change or have relative cell data.
Then for next month (when data tab gets reset) the next column must be filled in. If it's simpler I can add another row with an X in the active month's column, so the macro can check if there is an X in that row, then do the sum if for that column.
It's simple to run a sum if, copy paste to all non blank rows, and then recopy as value only. But not when I have 20+ sheets, and need to do that every month.
Ok, so here is an example of what you want to do. In this example, I have left it up to you to set in the code which column you are looking to fill this month.
Change the value of Const ColumnNumber = 4 to change the column you are filling this month 4=D, 5=E etc (Apologies I only work in R1C1 ref style).
FirstRow always appears to be 4, but I have left that there in case you need to change it.
Worksheetfunction.sumif takes parameters in the same order as the normal sumif, so I am passing in column 1 of the data sheet for the range, cell c of the same row as the criteria, and column 2 of the data sheet as the sum range.
Using worksheetfunction.sumif will return the value to the cell, not the formula so that solves your problem of the data sheet being deleted and recreated.
I have also left the option for you to fill in the green rows with something else.
Const ColumnNumber = 4
Const FirstRow = 4
Sub LoopSomeSheets()
Dim sht As Worksheet
'go through each sheet in the workbook
For Each sht In ThisWorkbook.Sheets
'ignore the sheet named "data"
If sht.Name <> "data" Then
Dim LastRow As Long
'figure out where the sheet ends
LastRow = sht.cells.SpecialCells(xlCellTypeLastCell).Row
'variable to sum totals
Dim RunningTotal as Double
For i = FirstRow To LastRow
If sht.Cells(i, 3).value = "SUM" Then
'Put the total value in the sum cell
sht.Cells(i, ColumnNumber).value = RunningTotal
'reset the total for the next group
RunningTotal = 0
Else
Dim SumOfData as Double
'get the sumif value
SumOfData = _
WorksheetFunction.SumIf(Sheets("data").Columns(1), sht.Cells(i, 2), Sheets("data").Columns(2))
'add to the running total
RunningTotal = RunningTotal + SumOfData
'then update the cell
sht.Cells(i, ColumnNumber).value = SumOfData
End If
Next i
End If
Next sht
End Sub