I am very new to VBA in excel and I have recorded and modified a macro that gets a value then based on an "IF" statement it uses the answer to calculate a value in a certain cell . I need to repeat this until there is a blank cell in column A.
My Data is
Part Number reported actual waste in the first 4 columns here follows my code that I need to repeat until column A is blank.
Sub MissingMix()
'
' MissingMix Macro
' Calculates Missing Mix based on scrap
'
' Keyboard Shortcut: Ctrl+q
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R3C8"
ActiveCell.FormulaR1C1 = "=IF(RC[-5]-RC[-6]>0,SUM(RC[-5]-RC[-6])*RC[+1],"""")"
Application.Goto Reference:="R3C9"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],'QAD Weights'!RC[-8]:R[37]C[-5],4)"
End Sub
use this:
' get active sheet
Dim CurrentSheet As Worksheet
Set CurrentSheet = ActiveWorkbook.ActiveSheet
' defining starting row
Dim Values As Range
Set Values = Rows(5)
For i = 2 To Values.Cells.Count - 1
If Values.Cells(i).Text <> "" Then
' Do Something ...
End If
Next
you can also do the check with If Not IsEmpty(Cells(i).Value) Then ...
EDIT
There is another way that you can handle this.
Dim CurrentSheet As Worksheet
Set CurrentSheet = ActiveWorkbook.ActiveSheet
' getting the lastrow by jumping to the last filled row of cell(1,1)
' cell(1,1) means the cell at row=1 and column=1 (column "A")
Dim LastRow As Long
LastRow = CurrentSheet.Cells(1, 1).End(xlDown).Row
MsgBox LastRow
Related
I have a macro that pastes a number of rows from a "Template" sheet into the next blank row on the active sheet.
In column 2 of the first row is the value "variable".
In Column 6 of the first row is a 3 digit number.
What I am wanting to do is increment the number in Column 6 by 1 when it is pasted. If there is no previous number on the active sheet, then it starts with 001.
As the sheet has other rows that don't contain numbers, and the rows with numbers are not at regular intervals, I am thinking the cell to increment needs to be determined in the following way (unless there is an easier logic) :
In Active Sheet, find last row in Column 2 that has value "variable".
Offset Column by 4, to get to cell in Column 6.
Take active cell value and increment by 1 in the pasted rows, using
the same criteria as above to determine which cell.
If there is no previous value of "variable" in Column 2 then value=001.
Here is the code I use to paste below into the next blank row.
Sub Paste_New_Product_from_Template()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Template")
Set pasteSheet = ActiveSheet
copySheet.Range("2:17").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).OFFSET(1, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
How could I incorporate the incrementing of numbers mentioned above?
EDIT
This is a sample of what the rows would look like on the Template sheet
And this is what the rows look like on Sheet1
Yes only incrementing Row 6. If no data in sheet then numbering starts from 001. Each sheet has independent numbering. If sheet has data then numbering starts from pasted row e.g. row 10. – aye cee
Let's say our sample data looks like this
LOGIC:
Set your input/output sheets.
Find the last cell to write to in the output sheet. Have to check if there is data previously or not.
If there is no data then copy across the header row.
Copy the range.
Ascertain the next number to be written in column 6.
Enter the number in the relevant cell in column 6 of the copied data and apply the 000 format.
CODE:
Is this what you are trying? I have commented the code so you should not have a problem understanding it but if you do them simply ask :)
Option Explicit
Sub Paste_New_Product_from_Template()
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim LRow As Long, i As Long
Dim StartNumber As Long
Dim varString As String
'~~> This is your input sheet
Set copySheet = Worksheets("Template")
'~~> Variable
varString = copySheet.Cells(2, 2).Value2
'~~> Change this to the relevant sheet
Set pasteSheet = Sheet2
'~~> Initialize the start number
StartNumber = 1
With pasteSheet
'~~> Find the last cell to write to
If Application.WorksheetFunction.CountA(.Cells) = 0 Then
'~~> Copy header row
copySheet.Rows(1).Copy .Rows(1)
LRow = 2
Else
LRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
'~~> Find the previous number
For i = LRow To 1 Step -1
If .Cells(i, 2).Value2 = varString Then
StartNumber = .Cells(i, 6).Value2 + 1
Exit For
End If
Next i
End If
'~~> Copy the range
copySheet.Range("2:17").Copy .Rows(LRow)
'~~> Set the start number
.Cells(LRow, 6).Value = StartNumber
'~~> Format the number
.Cells(LRow, 6).NumberFormat = "000"
End With
End Sub
IN ACTION
I'm having an Excel Spreadsheet with 3 sheets inside and I need to copy certain cell range from Sheet1 and copy it to Sheet2.
And I'm trying to get the range of cells to be copied as an input in a cell that is available in Sheet 3. Like the cell would have value A4:X6 in it. But I'm unable to get the input values passed on to the Range function in my Macro code.
Below is my code and when I execute, it just enters an empty row in the Sheet 2
Sub CopyData()
Sheet3.Select
Set Range1 = Range(Cells(3, 3).Value)
Sheet1.Select
Range1.Copy
Sheet2.Select
Range("A2").Select
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2.
Thank you in advance!
John Coleman is right you can avoid using Select for the whole subroutine. But, your problem here is when you define the range it is defining it specifically for Sheet3 and not Sheet1. One alternative is you could store the address in a string that gets passed to the Range() function, but specify which sheet you want your range to reflect. The rest of the code can be handled much the same without using Select.
Sub CopyData()
Dim range1 as Range
dim strRange as String
strRange = Sheet3.Cells(3, 3).Value
Set range1 = Sheet1.Range(strRange)
range1.Copy Sheet2.Range("A2")
Sheet2.Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
Use Set Range1 = Sheet3.Range(Cells(3, 3).Value) instead of Set Range1 = Range(Cells(3, 3).Value) or the range get selected from sheet1 because of Sheet1.Select
when i execute, it just enters an empty row in the Sheet 2 Of course it does. Your code does exactly that. Line Range("A2").EntireRow.Insert Shift:=xlShiftDown creates the row. There is nothing in your code that pastes the content of range A4:X6 ot whatever input you got in the cell.
Actually, if you delete your code and leave it like this:
Sub CopyData()
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
You will get the same, a new row inserted.
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2
I guess you are trying to copy a specific range, not a whole row and paste it, you need something like this:
Sub CopyData()
Dim Range1 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)
Range1.Copy
Sheet2.Range("A2").PasteSpecial (xlPasteAll) 'this command will paste the contents
End Sub
This example shows how to insert a line above line 2, copied to the format of the line down (line 3) and from the header line
Range("2:2").Insert CopyOrigin:=xlFormatFromRightOrBelow
As you understood, .Insert will always insert blank row.
I guess that you would like to paste a range in your sheet and not insert a new row for this you should do like this :
Sheets("SheetName").Range("A2").PasteSpecial (xlPasteAll)
Also note that xlPasteAll is an XlPasteType as xlPasteFormats , xlPasteValues and so on.
xlPasteAll will paste all
xlPasteFormats will paste the source format
xlPasteValues will paste the value
So your code would be as below :
Sub CopyData()
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)'Will define the range you want to copy
Range1.Copy 'here you copy the range
Set Range2 = Sheet2.Range("A2") 'Set the range where you want to paste data
Range2.PasteSpecial (xlPasteValues) 'then you will paste your range
End Sub
Click here to get the list of those XlPasteType
BONUS
Sheet2.Select
Range("A2").Select
is the same as
Set Range2 = Sheet2.Range("A2")
But the last way is better because it avoid Select which can slow down your performances !
Is there a specific requirement for inserting the copied data at the top or would you be happy adding it to the end of the "list" instead? If so, you could find the last used row and add it at the bottom instead like this:
Sub CopyFromSheet1toSheet2()
Dim thisBook As Workbook: Set thisBook = ThisWorkbook
Dim sheetOne As Worksheet: Set sheetOne = thisBook.Worksheets("Sheet1")
Dim sheetTwo As Worksheet: Set sheetTwo = thisBook.Worksheets("Sheet2")
Dim copyFromRange As Range: Set copyFromRange = sheetOne.Range("A4:X6")
Dim lastRow As Long: lastRow = sheetTwo.Cells(Rows.Count, 1).End(xlUp).Row
Dim pasteToRange As Range: Set pasteToRange = sheetTwo.Range("A" & lastRow)
copyFromRange.Copy Destination:=pasteToRange
End Sub
"lastRow" returns the numeric value of the last used row in a given column. If you have data in A1:A4 then this code would add the next lot of data copied to A5 and below.
This code is working to copy the filtered data of "Award" column marked "Yes" to another sheet; however, I'm receiving an error of "Type Mismatch." I'm not 100% now that the code is working properly to filter the data and copy correctly. I currently have 23 rows of test data for proper functionality. If I only put one row of data, then it doesn't copy and paste the data correctly. I am left with the copied 1st row of data plus the 2nd empty row of data. Additionally, it is not clearing the contents of the rows after the paste, so I may add new data as the days progress.
Sub CopySheet()
Dim i As Integer
Dim LastRow As Integer
Dim Search As String
Dim Column As Integer
Sheets("MasterData").Activate
Sheets("MasterData").Range("A1").Select
'Sets an Autofilter to sort out only your Yes rows.
Selection.AutoFilter
'Change Field:=5 to the number of the column with your Y/N.
Sheets("MasterData").Range("$A$1:$G$200000").AutoFilter Field:=7, Criteria1:="Yes"
'Finds the last row
LastRow = Sheets("MasterData").Cells(Sheets("MasterData").Rows.Count, "A").End(xlUp).row
i = 1
'Change the 3 to the number of columns you got in Sheet2
Do While i <= 11
Search = Sheets("ActiveJobStatus").Cells(1, i).Value
Sheets("MasterData").Activate
'Update the Range to cover all your Columns in MasterData.
If IsError(Application.Match(Search, Sheets("MasterData").Range("A1:G1"), 0)) Then
'nothing
Else
Column = Application.Match(Search, Sheets("MasterData").Range("A1:G1"), 0)
Sheets("MasterData").Cells(2, Column).Resize(LastRow, 1).Select
Selection.Copy
Sheets("ActiveJobStatus").Activate
Sheets("ActiveJobStatus").Cells(2, i).Select
ActiveSheet.Paste
End If
i = i + 1
Loop
'Clear all Y/N = Y
'Update the Range to cover all your Columns in MasterData.
Sheets("MasterData").Activate
Column = Application.Match("Award", Sheets("MasterData").Range("A1:F1"), 0)
Sheets("MasterData").Cells(2, Column).Resize(LastRow, 1).Select
Selection.ClearContents
End Sub
Sorry to change your code up so much, but it looks like you might be over-complicating how to do it.
This is some code from a previous question I answered where someone wanted to highlight a specific range whenever the word "Total" was found.
I changed the find to "Yes". Change the SearchRange to your column. (I think G is right).
Also, for future reference, Select should [almost never] be used.
It slows down code execution quite a bit and is not required.
I know the macro recorder likes to use it, but everything can be referenced without using select.
Brief example:
Sheets("ActiveJobStatus").Activate
Sheets("ActiveJobStatus").Cells(2, i).Select
ActiveSheet.Paste
Can Be replaced by:
Sheets("ActiveJobStatus").Cells(2, i).Paste
This code is working to copy the filtered data of "Award" column marked "Yes" to another sheet.
Sub CopyAwardsToActiveJobStatusSheet()
Dim SearchRange, First, Finder As Range
Dim PasteRow as Integer 'Add this to increment the rows we paste your data to
Set SearchRange = Sheets("MasterData").Range("G:G") 'Search This Range for "Yes"
Set Finder = SearchRange.Find("Yes") 'This is what we're looking for
If Finder Is Nothing Then Exit Sub 'We didn't find any "Yes" so we're done
'Drastically increases speed of every macro ever
'(well, when the sheets are modified at least - and it doesn't hurt)
Application.ScreenUpdating = False
First = Finder.Address 'Grab the address of the first "Yes" so we know when to stop
'Get the last row of column "A" on ActiveJobStatusSheet and start pasting below it
PasteRow = Sheets("ActiveJobStatus").Cells(Sheets("ActiveJobStatus").Rows.Count, "A").End(xlUp).Row + 1
Do
'Copy the entire row and paste it into the ActiveJobStatus sheet
'Column A and PasteRow (the next empty row on the sheet)
'You can change these if needed
Finder.EntireRow.Copy Sheets("ActiveJobStatus").Range("A" & PasteRow)
'If you just want A:G, you can use this instead:
'Finder returns the cell that contains "Yes",
'So we offset/resize to get the 6 cells before it and just copy that
'Resize doesn't like negative numbers so we have to combine:
'Finder.Offset(,-6).Resize(,7).Copy Sheets("ActiveJobStatus").Range("A" & PasteRow)
'Look for the next "Yes" after the one we just found
Set Finder = SearchRange.FindNext(after:=Finder)
PasteRow = PasteRow + 1 'Faster than looking for the end again
'Do this until we are back to the first address
Loop While Not Finder Is Nothing And Finder.Address <> First
'Clear MasterData
Sheets("MasterData").Range("A2:G" & Sheets("MasterData").UsedRange.Rows.Count).ClearContents
Application.ScreenUpdating = True 'Drastically increases speed of every macro ever.
End Sub
Just the code:
Sub CopyAwardsToActiveJobStatusSheet()
Dim SearchRange, First, Finder As Range
Dim PasteRow as Integer
Set SearchRange = Sheets("MasterData").Range("G:G")
Set Finder = SearchRange.Find("Yes")
If Finder Is Nothing Then Exit Sub
Application.ScreenUpdating = False
First = Finder.Address
PasteRow = Sheets("ActiveJobStatus").Cells(Sheets("ActiveJobStatus").Rows.Count, "A").End(xlUp).Row + 1
Do
Finder.EntireRow.Copy Sheets("ActiveJobStatus").Range("A" & PasteRow)
Set Finder = SearchRange.FindNext(after:=Finder)
PasteRow = PasteRow + 1
Loop While Not Finder Is Nothing And Finder.Address <> First
Sheets("MasterData").Range("A2:G" & Sheets("MasterData").UsedRange.Rows.Count).ClearContents
Application.ScreenUpdating = True
End Sub
Results:
MasterData Sheet:
ActiveJobStatus Sheet:
In reference to: Copy a row in excel if it matches a specific criteria into a new worksheet
I attempted applying the above hyperlink code to the needs of my own workbook. The only notable differences are: Object names, My data begins in "A2" instead of "A1", and my data is being copied to "L" column in a new worksheet instead of "A" column
Also... you can assume I have generated tabs in excel that correspond with each SelectCell.Value.
Sub Consolidate_Sheets()
Dim MyCell As Range
Dim MyRange As Range
Dim ws As Worksheet
Set MyRange = Sheets("Install_Input").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Call superSizeMe(MyCell, MyRange)
Sub superSizeMe(SelectCell As Range, SelectRange As Range)
Dim InstallInput As Worksheet
Dim strPasteToSheet As String
'New worksheet to paste into
Dim DestinationSheet As Worksheet
Dim DestinationRow As Range
'Define worksheet with input data
Set InstallInput = ThisWorkbook.Worksheets("Install_Input")
For Each SelectCell In SelectRange.Cells
InstallInput.Select
If SelectCell.Value <> "" Then
SelectCell.EntrieRow.Select ''''LOCATION OF RUN-TIME ERROR 438''''
Selection.Copy
Set DestinationSheet = Worksheets(SelectCell.Value)
Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
Range("L" & DestinationRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If
Next SelectCell
InstallInput.Select
InstallInput.Cells(1, 1).Select
If IsObject(InstallInput) Then Set InstallInput = Nothing
If IsObject(SelectRange) Then Set SelectRange = Nothing
If IsObject(SelectCell) Then Set SelectCell = Nothing
If IsObject(DestinationSheet) Then Set DestinationSheet = Nothing
If IsObject(DestinationRow) Then Set DestinationRow = Nothing
End Sub
I am getting a Run-time error'438'
"Object doesn't support this property or method" on "SelectCell.EntireRow.Select"
Well your code has a typo
SelectCell.EntrieRow.Select
should say entire not Entrie. Personally I would use this method anyway, It selects the entire row based on the number you put in. FYI there is also a corresponding Columns().select if you need it in the future
sel_cell_row = SelectCell.Row
Rows(sel_cell_row).select
edit addressed to comment
The reason you get the 1004 error is like it says, the copy and paste areas don't match. Think of copying 10 rows, and trying to paste it into 2 rows, simply wouldn'y work. I'm guessing the problem actually stems from your destinationrows code. I'm not entirely sure what its trying to do, but here are two generic fixes
1)keep the copy code as it is, and modify the paste. Instead of selecting a range of cells to paste into, select the first cell (if your range was a1:a10, selecting a1 is sufficient) excel will then paste all the data starting at that first cell. so in your code do this
'comment out all this destination row stuff
'Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
'Range("L" & DestinationRow.Rows.Count + 1).Select
Range("L1").select 'only referencing the first cell to paste into
ActiveSheet.Paste
2)rather than selecting an entire row, why not select only the populated values in that row something like
sel_cell_row = SelectCell.Row
lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
range(Cells(sel_cell_row ,1),Cells(sel_cell_row ,lastColumn )).select
then do your copy as usual. the 1 is for column 1, or A. I'm assuming the data you want is in one row starting at column A and going till lastColumn. Maybe now this will match your destinationrows code.
3)Com,bine options 1 and 2. so copy only the populated cells, and paste to the first cell in the range
I have a worksheet titled CASES-PENDING, with many rows of data. On a daily basis I change the status of a particular row's beginning cell to "done" (changed from "pending"). Instead of then having to cut that row and paste on my other CASES-DONE titled worksheet, I'd like a macro to do that.
I want to run the macro after changing the status of several rows of data, from "pending" to "done". Then all those rows must be cut and pasted on the other worksheet.
Is that possible?
Thanks so much guys!
This is just a stab in the dark, but I've been handling something similar to this as of late.
Dim LastRow As Long
Range("1:1").AutoFilter Field:=(Row you have "Done" in), Criteria1:="Done"
LastRow = Cells(Rows.Count, 3).End(xlUp).Row
Range("CellRangeYouNeedCopied" & LastRow).Copy Destination:=Sheets("SheetX").Range(X,Y)
Basically this filters to only the rows with DONE in them, and copys and pastes them on whatever other sheet you decide to name. Just remember to replace all of the variables. I'm still pretty new at this, so I may be wrong but it's worth a shot!
Edit:You can also just record this as a macro, and then change the range so that it's variable using the Long variable.
You can also do it like this. More code, than the AutoFilter solution, but maybe more flexible.
Sub MoveDoneRows()
Dim nStatusCol As Integer
nStatusCol = 1
Dim i As Integer
i = 2
' select first row to insert rows into DONE sheet
Dim nInsertRow As Integer
Sheets("CASES-DONE").Select
Range("A1").Select
Selection.End(xlDown).Select
nInsertRow = ActiveCell.Row + 1
' move rows with status done
Dim sStatus As String
Dim sPasteRow As String
sStatus = Sheets("CASES-PENDING").Cells(i, nStatusCol).Value
While sStatus <> ""
If sStatus = "done" Then
' cut the current row from PENDING sheet
sPasteRow = i & ":" & i
Sheets("CASES-PENDING").Select
Rows(sPasteRow).Select
Selection.Cut
' paste into DONE sheet
Sheets("CASES-DONE").Select
Cells(nInsertRow, nStatusCol).Select
ActiveSheet.Paste
nInsertRow = nInsertRow + 1
' delete empty row from PENDING sheet
Sheets("CASES-PENDING").Select
Rows(sPasteRow).Select
Selection.Delete Shift:=xlUp
Else
i = i + 1
End If
sStatus = Sheets("CASES-PENDING").Cells(i, nStatusCol)
Wend
End Sub