I tried to use my other similar VBA code but I don't think I understand what I'm trying to replace for the range. In this code, I am trying to copy the data in the Repeating Items sheet in the fourth column with the cell value of 12, then paste it to the last worksheet.
' Repeating items worksheet
Worksheets("Repeating Items").Select
ActiveSheet.ShowAllData
b = Worksheets("Repeating Items").Cells(Rows.Count, 1).End(xlUp).Row
' Filters the data where column 2 equals to 12 to x. ** this is where the error starts
ActiveSheet.Range(Cells(1, 1), Cells(b, 4)).Autofilter Field:=4, Criteria1:="12", Operator:=xlFilterValues
' Selects only the filtered cells and copy
Range(Cells(2, 1), Cells(b, 4)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count).Select
ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
Per the Microsoft Documentation, you can just apply the filter to the first row much how you would manually do in excel and it will automatically filter your range. You don't need to quote your number filter FYI (unless the column is Text).
Also, no need to Select anything here. It is just a middle man operator that only slows your code down. Instead, explicitly define your objects (sheets and ranges) and skip right to the action statements (copy/paste).
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Repeating Items")
Dim ls As Worksheet: Set ls = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:D1").AutoFilter Field:=4, Criteria1:=12
ws.Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Copy
ls.Range("A" & ls.Range("A" & ls.Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
End Sub
Related
What I'm trying to do is open one workbook, copy all the data on the first sheet of it and then adding that data to the first empty row of a sheet in another workbook. I seem to run into a problem when pasting the data but I don't fully understand why. I have run the code and just copied the top row of a sheet and then used my method of finding the first empty row and pasting it there which has worked, so I must be something with how I'm copying / selecting my date.
Here is the code :
MyFile6.Activate
MyFile6.Worksheets(1).Activate
Cells.Select
Selection.Copy
Windows("Frávikagreining.xlsm").Activate
Sheets("Laun").Select
Dim Rng As Long
Rng = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(Rng, 1).Select
ActiveSheet.Paste
I have already defined and opened the workbook "MyFile6" (code not shown here). So I copy the data on the first sheet of this workbook MyFile6, then I open the sheet "Laun" at another workbook, find the last used row in column A, go one further down (first empty cell) and select that. But then my paste attempt is stopped by an error.
Any help / better way to do this would be greatly appreciated !
Cells.Select
Selection.Copy
You are getting that error because you are copying ALL Cells but not pasting in A1. And hence the error. You are trying to fit a bigger object into a smaller object. Work with realistic range objects instead of All Cells by finding last row in first sheet as well and then identifying the range to copy and then pasting accordingly.
Also avoid the use of .Select/Activate. You may want to see How to avoid using Select in Excel VBA
Your code can be written as (UNTESTED)
Dim lRow As Long, lCol As Long
Dim rngToCopy As Range
Dim thatWb As Workbook
'~~> Destination Workbook
Set thatWb = Workbooks("Frávikagreining.xlsm")
With MyFile6.Worksheets(1)
'~~> Find last row and column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'~~> Set your range to copy
Set rngToCopy = .Range(.Cells(1, 1), .Cells(lRow, lCol))
End With
With thatWb.Sheets("Laun")
'~~> find last row in destination sheet for pasting
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
'~~> Copy and paste
rngToCopy.Copy .Range("A" & lRow)
End With
I'm very new to VBA and was hoping to get come clarification on a project. I've tried solving it with formulas but I need to still be able to enter information into cells and not have them filled with a lookup formula.
How I'm looking for it to preform is that if an object requires it to be shipped then the serial numbers and identifiers are copied and pasted in another table in the next blank row automatically.
Information divided into two tables
What I thought I needed was a segment in VBA that went like this:
Sub CopyCat()
If Range("J2") Like "*yes*" then
Range("G2:I2").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
If Range("J3") Like "*yes*" then
Range("G3:I3").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
End If
End If
End Sub
It does exactly what I ask it to do when it is only the first statement, when I add the second one to check if the next row satisfies the conditions and it does, then it places it in the same resulting cell as the first statement. If both are true I need them both to be displayed in table 1.
I'd love to take this as a learning opportunity so any information or direction you can point me in would be great! Thank you so much in advance!
I think Range("A2:A10").end(xlup) is equivalent to Range("A2").end(xlup) so will not change, but you don't want the A2 reference, you want to work up from the bottom. You will hit problems if you are going beyond A9. (Plus not sure you want nested Ifs.)
If Range("J2") Like "*yes*" Then
Range("G2:I2").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
If Range("J3") Like "*yes*" Then
Range("G3:I3").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
Or to add a loop and circumvent the copy/paste you could use something like this:
Sub CopyCat()
Dim r As Long
For r = 2 To Range("J" & Rows.Count).End(xlUp).Row
If Range("J" & r) Like "*yes*" Then
Range("A10").End(xlUp).Offset(1).Resize(, 3).Value = Range("G" & r).Resize(, 3).Value
End If
Next r
End Sub
You can also do this without VBA.
In A2, you can use this formula entered as an array formula with CTRL+SHIFT+ENTER:
=INDEX($G$2:$G$4,SMALL(IF($J$2:$J$4="yes",ROW($J$2:$J$4)-ROW($J$2)+1),ROWS(J$2:J2)))
And in B2, you can put this and drag down/over from B2:D3:
=INDEX(H$2:H$4,MATCH($A2,$G$2:$G$4,0))
Finally, to hide the errors that show when there are no more matches, you can simply wrap both above formulas in IFERROR([formula above],"").
With autofilter
Sub copyRange()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim lastRow As Long
Dim filterRange As Range
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet2") 'change to sheet name containing delivery info
With wsSource
lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
Set filterRange = .Range("G1:K" & lastRow)
Dim copyRange As Range
Set copyRange = .Range("G2:K" & lastRow)
End With
Dim lastRowTarget As Long, nextTargetRow As Long
With filterRange
.AutoFilter
.AutoFilter Field:=4, Criteria1:="yes" 'change field to whichever is the field in the range containing your company names
lastRowTarget = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
nextRowTarget = lastRowTarget + 1
Union(wsSource.Range("G2:I" & lastRow).SpecialCells(xlCellTypeVisible), wsSource.Range("K2:K" & lastRow).SpecialCells(xlCellTypeVisible)).Copy wsSource.Range("A" & nextRowTarget)
.AutoFilter
End With
End Sub
I have a code that finds the last row of data in column E and selects the column to that last row. I want to be able to select associated data in columns B through D that goes with column E and then sort based on column B. So I thought I would just find the last row in column E then resize by 3 columns and sort from that selection but I keep getting a run-time error 1004 application-defined or object-defined error. I have provided the code I'm using below. Columns B through D contain data past the end of column E. Thanks!
ws.Range("E1:E" & finalrow).Resize(0, 3).Select
You may not always be starting in the first row (e.g. E1) so lastRow may not be applicable without some maths. In that case, use With ... End With statements to shorten the code while explicitly referencing the correct cell and cell ranges.
dim lastRow as long
with ws
lastRow = .cells(.rows.count, "E").end(xlup).row
'option 1
.range("B5:D" & lastRow).select
'option 2
with .range("E5:E" & lastRow)
.offset(0, -3).resize(.rows.count, 3).select
end with
'option 3
.range("E5", .cells(lastRow, "G")).offset(0, -3).select
end with
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on Range.Select and Range.Activate to accomplish your goals.
Something like:
Sub SelectLast3Cols()
Dim ws As Worksheet, lrow As Long
Set ws = Sheets("Sheet3")
lrow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
ws.Range("B1", ws.Range("D" & lrow)).Select
End Sub
Okay, I'm learning scripting for Excel and I've come across something that I just don't know how to do.
I've been asked to help automate the import of a sheet into a sheet and then add some columns off to the side and do some calculations and autofill them to the last row of the imported info. That is no problem. I recently found out however that the sheet that I would import for my office has X number of columns and other offices have Y and Z number of columns in the sheets that they would import. So I'm trying to do this to where it builds the calculation columns at the end of the imported columns. With that bit of background here's where I need some assistance:
Script as written for my office and works:
Range("O1").Select
ActiveCell.FormulaR1C1 = "Remainder"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=MOD(RC[-14],RC[-5])"
Range("O2").Select
Range("O2").AutoFill Destination:=Range("O2:O" & Cells(Rows.Count, "B").End(xlUp).Row)
So now I need to make this relational not Cell Address Specific So I came up with this.
Range("A1").select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Threshold"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-13]>(RC[-5]/3),""Over"",""Under"")"
Range(ActiveCell.Address).AutoFill Destination:=Range(*****How to return the Current Cell Address** : **How to Return the Current Column Letter***** & Cells(Rows.Count, "B").End(xlUp).Row)
I've Tried "ActiveCell.Address":"CHAR(COLUMN()+64))" but That doesn't work and I Just don't know how to get it to set that value to Be the equivalent ?2:? my office running this should autofill from O2:O. But would return P2:P in another.
I'm assuming you want the formula to go in the 1st unused column, no matter how many columns there are. (This will allow for future column use, as well.)
Dim LastCol as integer
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
Cells(1, LastCol).FormulaR1C1 = "Remainder"
Cells(2, LastCol).FormulaR1C1 = "=MOD(RC[-14],RC[-5])"
Cells(2, LastCol).AutoFill Destination:=Range(Cells(2, LastCol), _
Cells(Cells(Rows.Count, "B").End(xlUp).Row, LastCol))
How's this:
Sub test()
Dim lastCol As Integer, lastRow As Integer, formulaCol As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
' First, let's find the last column (#) and last row (#)
With ws.UsedRange
lastCol = .Columns.Count
lastRow = .Rows.Count
End With
' Now, create the "header, two columns offset from last column"
formulaCol = lastCol + 2
Cells(1, formulaCol).Value = "Remainder"
'Now, let's create a range, that we will fill with the MOD() formula. You can do this _
through resizing a range, instead of selecting and autofill
With ws
.Range(.Cells(2, formulaCol), .Cells(2, formulaCol)).Resize(lastRow - 1, 1).FormulaR1C1 = _
"=IF(RC[-" & formulaCol - 1 & "]>(RC[-2]/3),""Over"",""Under"")"
End With
End Sub
I am assuming a few things: Your raw sheets come with the data in one block. In other words, you don't have a gap of columns between data you need. This will get the last used column and row, and use those to enter your formula.
Also, I assume that you are checking that the first part of your mod() formula refers to the info in Col. A, and the second part is the right most column's data. I think I'm not understanding something, so any more info. about how the data is laid out would be helpful. But also, this avoids using "Select", which is good VBA practice from what I've gathered.
I have a table put together as a database. I am trying to write a macro to search a System Size column in my table to find "2500" then search a Standard column to find "Standard" then search a Category column to find "FL" I then want to copy the value from a Select Item column pertaining to the row these values were found in to another sheet. For example, the macro will search Column E (System Size) for all "2500", then it will search Column F (Standard) for all "Standard", then it will search Column G (Category) for all "FL". I then want it to copy the values from Column C (Select Item) for every line that meets these requirements and paste it to another sheet. Following is the code I have so far but I can only get it to search one cell and not the entire column. There is probably a better way to go about it but this is the only way I have found that works.
Sub ImDoingMyBest()
'
' ImDoingMyBest Macro
'
'
If Sheets("Database").Range("E2").Value Like "*2500*" Then
Sheets("Database").Range("C2").Copy
Sheets("Quote Sheet").Select
Range("B26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
End Sub
The way to search the whole column is to use a for-loop; for instance:
For i = 1 To 10000
If Sheets("Database").Range("E" & i).Value Like "*2500*" Then
Sheets("Database").Range("C" & i).Copy
...
...
End If
Next i
Alternatively (and my preference) use the Cells(row, column) format rather than Range - this avoids having to concatenate the Range reference. This would take
Range("E" & i)
and change to
Cells(i, 5)
which is neater code (IMO).
Following up on Siddarth Rout's comments, the following code uses Autofilter to isolate the rows in the "Database" sheet that meet your criteria, and then copies the corresponding values in column C to a range beginning in cell B26 of the sheet named "Quote Sheet".
Sub FilterAndCopy()
Dim dataWs As Worksheet
Dim copyWs As Worksheet
Dim totRows As Long
Dim lastRow As Long
Set dataWs = Worksheets("Database")
Set copyWs = Worksheets("Quote Sheet")
With dataWs
.AutoFilterMode = False
With .Range("C:G")
.AutoFilter Field:=3, Criteria1:="2500"
.AutoFilter Field:=4, Criteria1:="Standard"
.AutoFilter Field:=5, Criteria1:="FL"
End With
End With
totRows = dataWs.Range("C:C").Rows.count
lastRow = dataWs.Range("C" & totRows).End(xlUp).Row
dataWs.Range("C2:C" & lastRow).Copy
copyWs.Range("B26").PasteSpecial Paste:=xlPasteValues
dataWs.AutoFilterMode = False
End Sub