Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.
Related
My data range needs to be copied from one tab to another. The key to this is it needs to paste the information in the data range into a new row, even if the information is the same. So each time it is run a new row will be populated. Another key here is the row data range consists of criteria, depending on the value of criteria the code will decide which tab to copy into.
I was able to create the code to copy but without if statement and it copies into the same row each time
if Cell E3 = "Revenue" then copy into Revenue worksheet, if not then copy into Cost worksheet.
Each time code is run, the data will be copied into the last unoccupied row available in that worksheet
If I understood You right, this should work:
Sub copy2sheet()
Dim cond As String
Dim lastRow As Integer
With Sheets(ActiveSheet.Name)
'taking name of the sheet from "E3"
cond = .Range("E3").Value
'checking last filled row in sheet we gonna copy data
lastRow = Sheets(cond).Cells(Rows.Count, 1).End(xlUp).row
'copy data starting from "A1" to every cell is close to - CurrentRegion
'a paste it into first empty cell in column "A"
'.Range("A1").CurrentRegion.Copy Sheets(cond).Range("A" & lastRow + 1)
.Range("E3:H3").Copy Sheets(cond).Range("A" & lastRow + 1)
End With
End Sub
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.
My aim with this bit of code is to paste the contents of column D into a different Sheet if the contents in column N on the same row within the initial Sheet is = "REDUCE ONLY".
I'm struggling to find a way to paste all the entries into the second Sheet with no blank rows between them.
Currently I'm sorting the initial Sheet so all the REDUCE ONLY entries are in order at the top of the column N so they're ordered correctly in the output sheet but this isn't very robust if I get a different set of values to what's expected in column N. Is there a different way to phrase:
"cfdSht.Cells(c.Row - 1, 1).PasteSpecial Paste:=xlPasteValues"
So far I've got:
Dim c As Range
Dim rCheck As Range
Dim LRMAIN As Long
Dim cfdSht As Worksheet
Dim mainSht As Worksheet
Set mainSht = ThisWorkbook.Worksheets("Sheet1")
Set cfdSht = ThisWorkbook.Worksheets("ProductSettingNgCfd")
''Set Last Row
LRMAIN = mainSht.Range("A2").CurrentRegion.Rows.Count
''Set Range
Set rCheck = mainSht.Range("B2:N" & LRMAIN)
''Copy any value in column D where the value on the same row in column N is "REDUCE ONLY". Paste into second Sheet with starting point adjusted up 1 row.
For Each c In rCheck
If c.Value = "REDUCE ONLY" Then
mainSht.Cells(c.Row, 4).Copy
cfdSht.Cells(c.Row - 1, 1).PasteSpecial Paste:=xlPasteValues
End If
Next
Thanks
Replace this:
mainSht.Cells(c.Row, 4).Copy
cfdSht.Cells(c.Row - 1, 1)
With this
cfdSht.Cells(cfdSht.RowsCount, 1).End(xlUp).Offset(1).value = mainSht.Cells(c.Row, 4).Value
The first part will start at the bottom of the sheet then go up to the first occupied cell then move one down to the first unoccupied cell.
I used the direct assign method, because it is less taxing on the process than copy and paste. As you were looking only for values this will just put the value of the one cell into the other.
I want to make drop Down List in sheet2 which contains values from sheet1 column. I have tried this code.
Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 10 ' 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("B").Column).Value = "YourCriteria" 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
columns in sheet1 are changing oftenly. so needs to create Dynamic VBA Macro code.
Please guide me for this query.
For your case, I don't think that you need a macro to manage the drop down list but perhaps data validation will do.
Create a new worksheet,
I got a worksheet contain the following data at column A
At the worksheet that i want the dropdownlist, i just highlight the cell and click on the data validation button at data ribbon
In the data validation, create the following setting
Click on the ok button and the list will be created
Since in the columns in the worksheet(source) keep on changing, you need write the macro to copy the entire needed column exclude the header of the column to next worksheet(e.g. worksheet that create the dropdown list).
Edited: Code to detect the criteria column and copy the column
Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyWorksheet2 As Worksheet
Dim WantedColumn As Long
Dim ColumnPointer As Long
Sub copyCriteria()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("Sheet6")
Set MyWorksheet2 = MyWorkbook.Sheets("Sheet5")
For ColumnPointer = 1 To MyWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
If MyWorksheet.Cells(1, ColumnPointer).Value = "ColumnE" Then
MyWorksheet.Columns(ColumnPointer).Copy
MyWorksheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
MyWorksheet2.Rows("1:1").Delete Shift:=xlUp
End If
Next
End Sub
What you are trying to do can be done with a simple named range and Data Validation to use that Name. If you have not heard of Dynamic Ranges, then you should read on.
If Sheet1 only has the 1 column for the DropDown list via Data Validation, you should use a Named Range instead of a fixed Range. But this named range is dynamic (by using formula)! See OFFSET usage.
Lets say Sheet1 is like below:
Lets say the name to be used is MyList, then in Excel click Name Manager in Formulas tab, and place in below as the Range Refers to:
=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A))
Now in Sheet2, the Data Validation is placed on B2, when setting it up, once you put in the source to =MyList, Excel highlights it:
Then the drop down list worked:
Now if you add data to your list (Column A on Sheet 1), the MyList automatically expands and hence your DataValidation drop down list!
Note the list will go up to the first blank cell in Column A, so NO GAPS!
Enjoy!
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.