Column selection to lastrow then resize - excel

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

Related

Formula Auto Fill VBA

I managed to get this to work, but the problem is I have to specify the range (in this case I just hard coded C2:c25 and the file will have different row counts every time.
Is there a way to make this run only for the rows that have data?
Sub addFormulas()
ThisWorkbook.Worksheets("Sheet2").Range("C2").Formula = "=(B2/12)*100"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C25")
End Sub
You could use xlDown to find your last row number based on column B, so you won't have to change your code next time.
Sub addFormulas()
ThisWorkbook.Worksheets("Sheet2").Range("C2").Formula = "=(B2/12)*100"
Range("C2").Select
'find last row with value
last_row = Range("B2").End(xlDown).Row
Selection.AutoFill Destination:=Range("C2:C" & last_row)
End Sub
But I'm assuming that column B doesn't have blank cells between values. In case column B may have blank cells, you could run a FOR loop to find the last row. It's a lot less efficient, but it works well as long as you don't have a very large number of rows:
Sub addFormulas2()
ThisWorkbook.Worksheets("Sheet2").Range("C2").Formula = "=(B2/12)*100"
Range("C2").Select
For i = 1 To 20
If Range("B" & i) & "" > "" Then last_row = i
Next i
Selection.AutoFill Destination:=Range("C2:C" & last_row)
End Sub
EDIT: Just learned here that using xlUp ir more efficient than FOR and more reliable than xlDown, since it won't have any problems if there's some blank cell in column B:
Sub addFormulas_()
ThisWorkbook.Worksheets("Sheet2").Range("C2").Formula = "=(B2/12)*100"
Range("C2").Select
With Sheets("Sheet2")
last_row = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Selection.AutoFill Destination:=Range("C2:C" & last_row)
End Sub
You can accomplish your task without using AutoFill or Select. It is better to use a With … End With statement. Comments are provide in the code below.
Sub addFormulas()
With ThisWorkbook.Worksheets("Sheet2") 'used to set the focus on the worksheet object
.Cells(2, 3).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Formula = "=(B2/12)*100"
'writes the formula in the variable range in column C
'Breakdown...
'the "." (dot) e.g. (.Cells and .Rows) is used to refer to the worksheet object in the With statement
'".Cells(2, 3)" is the start of the range you want to write the formula
'".Resize(.Cells(.Rows.Count, 2).End(xlUp).Row")expands the range to the last use row in column B
'the "- 1" adjusts your range because you started on row 2
End With
End Sub

VBA - Copy and paste the data from the 4th column

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

How to remove duplicate rows in a spreadsheet

In column 'M' i have hundreds of rows with multiple duplicates. I only want one record to show per duplicate when i run my macro. Below is my code and it deletes all records apart from one.
Sub DeleteRows()
With ActiveSheet
Set Rng = Range("M5:M").End(xlDown)
Rng.RemoveDuplicates Columns:=1, Header:=xlYes
End With
End Sub
It starts from M5 as this is where the data is initially. Why would it only be showing one record?
Your original attempt, Range("M5").End(xlDown), is just one cell.
Your new attempt, Range("M5:M").End(xlDown), is closer but not a valid Range reference.
Try the following:
Set Rng = Range("M5:M" & Cells(Rows.Count, "M").End(xlUp).Row)
EDIT:
If you're dealing with an entire range, you need to specify the Columns argument of Range.RemoveDuplicates, something like this:
Sub RemoveDupes()
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A5:V" & lastRow).RemoveDuplicates Columns:=Array(13), Header:=xlYes ' column M = 13
End Sub

Append Data to the Last Row of another Worksheet

I simply need to grab a column (range) from one sheet, and append to another sheet. For some reason I keep getting an error 1004 - object/application defined error when trying to run the paste values function.
Any help would be appreciated.
Sub copycontactsiratotpsd()
Dim LastRowIRA2 As Long
Dim LastRowIRA As Long
Dim LastRowPOV As Long
Dim lastrow As Long
'activate source sheet
ActiveWorkbook.Worksheets("IRA").Activate
'copy from rev to ira AG to match # of rows for TPRM Contacts before appending
ActiveWorkbook.Sheets("Rev").Range("B2:B15000").SpecialCells(xlCellTypeVisible).Copy
ActiveWorkbook.Sheets("IRA").Range("AG2:AG15000").PasteSpecial xlPasteValues
'define last rows for all three instances
LastRowIRA = ActiveSheet.Range("A1").CurrentRegion.Rows.count
LastRowIRA2 = ActiveSheet.Range("AG1").CurrentRegion.Rows.count
lastrow = WorksheetFunction.Max(Sheets("TPD").Cells(Rows.count, "A").End(xlUp).Row)
LastRowPOV = ActiveWorkbook.Sheets("TPD").Range("A1").CurrentRegion.Rows.count
'if the number of lastrow in source sheet is equal to total VISIBLE last row within reference sheet then
If LastRowIRA = LastRowIRA2 Then
ActiveWorkbook.Worksheets("IRA").Activate
'copy the data needed, values are generally less than 10000 rows
ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Range("A", lastrow).PasteSpecial xlPasteValues
'LINE WITH ERROR ABOVE
'else display msg for error handling
Else: MsgBox "Row Count is off! *CHECK*"
End If
ActiveWorkbook.Worksheets("IRA").Activate
Columns(33).EntireColumn.Delete
End Sub
To allow an answer to close this out:
ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Cells(lastrow, "A").PasteSpecial xlPasteValues
Or:
ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Range("A" & lastrow).PasteSpecial xlPasteValues

vba copy and paste range value when two or more conditions are satisfied into the next empty cell

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

Resources