I'm very new to VBA and I can't quite find the answer im looking for. The rest of my code is working, but when it comes to autofilling, I can't seem to get it. I have a cell, and I want to autofill just to the cell below. I know its a very basic question, but any help is appriciated! Here's my code:
Selection.AutoFill Destination:= Range(Cells.ActiveCell.Offset(1,0), Type:= _
xlFillDefault
You could use Resize
Option Explicit
Sub Test()
Selection.AutoFill Destination:=ActiveCell.Resize(2, 1), Type:=xlFillDefault
End Sub
Try out these tests. The code for column A answers your original question.
Option Explicit
Sub AutofillTest()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim aRng1 As Range, aRng2 As Range
'Autofill beginnining with only one cell as a "seed"
ws.Range("a:d").Clear
Set aRng1 = ws.Range("a1:a1")
aRng1 = 1 'The "seed" cell
Set aRng2 = aRng1.Offset(1, 0)
aRng1.AutoFill Destination:=Range(aRng1, aRng2), Type:=xlFillSeries
'More fun tests
ws.Range("b1:b1") = 1
ws.Range("c1:c1") = 1
ws.Range("d1:d1") = CDate("5/1/2018")
ws.Range("b1:b1").AutoFill Destination:=Range("b1:b5"), Type:=xlFillSeries 'List of numbers
ws.Range("c1:c1").AutoFill Destination:=Range("c1:c5"), Type:=xlFillDefault 'Copy of one number
ws.Range("d1:d1").AutoFill Destination:=Range("d1:d5"), Type:=xlFillDefault 'List of dates
End Sub
.AutoFill is overrated, Both .FillDown/.FillRight and .DataSeries are usually better methods and filling everything at once with relative content is always an option for formulas or constants.
Selection.filldown 'ctrl+D is faster
'or,
Selection.cells(1).resize(2, 1).filldown
...
Selection.cells(1).resize(2, 1) = Selection.cells(1).formula
...
Selection.cells(1).resize(2, 1).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
...
'only if you're feeling lucky
selection.flashfill
You haven't provided anywhere near enough information to offer a definitive answer but all of the above are viable alternatives to the guessing game called .AutoFill with a Type:=xlFillDefault argument.
Related
I want to stop my loop if the current selection is empty. I have tried the following:
If (IsEmpty(Sheets("Sheet3").ActiveCell)) Then Exit Do
If Sheets("Sheet3").Selection.Value = "" Then Exit Do ;tried to replace "" with Empty and Nothing but didn't work either
If Sheets("Sheet3").Activecell.Value is Empty Then Exit Do
If Sheets("Sheet3").Selection is blank Then Exit Do
The issue is if I don't stop the loop somehow it will carry on forever.
I was hoping somebody can help me here.
EDIT :
This is my code:
Public Sub CopyFilteredData()
Do
Sheets("Sheet4").Select
ActiveSheet.Range("$A$1:$R$25239") _
.AutoFilter _
Field:=5, _
Criteria1:=Sheets("Sheet3").Application.Selection.Value
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("Sheet5").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "+"
Sheets("Sheet3").Select
Selection.Offset(1, 0).Select
' This is where the code to stop the loop needs to go
Loop
End Sub
This question is a classic case of the XY Problem.
Y Solution
The main reason none of your four attempts to detect an empty cell work, is a lack of understanding on what Selection and ActiveCell actually are. They are properties of the Application object and return the following
Selection - the selected object of the active sheet (the top most sheet)
ActiveCell - the active cell of the active sheet (the top most sheet)
You can't use Sheets("Sheet3").ActiveCell or Sheets("Sheet3").Selection as the Sheet object doesn't have these properties.
What you can use is Application.ActiveCell and Application.Selection or, more simply, ActiveCell and Selection. Of course, this will only work after activating Sheet3.
My preferred way of doing this is:
Sheets("Sheet3").Activate
If (IsEmpty(ActiveCell)) Then Exit Do
Your code also contains a similar problem with this bit:
Criteria1:=Sheets("Sheet3").Application.Selection.Value
While the code correctly gets the Selection object, it doesn't actually activate Sheet3 and is exactly the same as writing:
Criteria1:=Application.Selection.Value or Criteria1:=Selection.Value
Fixing this issue by storing the Sheet3 selection value in a variable leads to the following working code:
Option Explicit
'(v0.2)
Public Sub Y_Fixed_BUT_VERY_VERY_VERY_BAD_CODE()
' Added three lines and changed a fourth to fix the incorrect usage of "Selection" for the criteria
' Changed a fifth line to add the correct loop exit code
Sheets("Sheet3").Activate ' Fix#1 Not necessary if the code is always run from Sheet3
Dim varSheet3ActiveCellValue As Variant ' Fix#2
Do
varSheet3ActiveCellValue = ActiveCell.Value2 ' Fix#3
Sheets("Sheet4").Select
ActiveSheet.Range("$A$1:$R$25") _
.AutoFilter _
Field:=5, _
Criteria1:=varSheet3ActiveCellValue ' Fix#4
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("Sheet5").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "+"
Sheets("Sheet3").Select
Selection.Offset(1, 0).Select ' Fix#5
If IsEmpty(ActiveCell) Then Exit Do
Loop
End Sub
X Solution
As mentioned in response to your first posted question, you really, really need to learn how to avoid using .Select. This Stack Overflow post is a good place to start.
The following code is the equivalent to the above, without using a single .Select, .Activate, Selection, or ActiveCell. It also includes a better way to find the last value in a column. (Your method fails unless there is a least one cell containing a value after the first cell.)
A useful way to work out how the code works is to select a word in it, for example With and pressing F1. This will bring up the Excel Help related to that word, with explanations and examples.
'============================================================================================
' Module : <in any standard module>
' Version : 1.0
' Part : 1 of 1
' References : N/A
' Source : https://stackoverflow.com/a/47468132/1961728
'============================================================================================
Option Explicit
Public Sub X__GOOD_CODE()
Dim rngFilterCriteriaList As Range
With Sheets("Sheet3").Range("A3")
Set rngFilterCriteriaList = Range(.Cells(1), .EntireColumn.Cells(Rows.Count).End(xlUp))
End With
Dim rngCell As Range
For Each rngCell In rngFilterCriteriaList
Sheets("Sheet4").Range("A1:R25239") _
.AutoFilter _
Field:=Range("E:E").Column, _
Criteria1:=rngCell.Value2
Sheets("Sheet4").Range("A1").CurrentRegion.Copy _
Destination:=Sheets("Sheet5").Range("A:A").Cells(Rows.Count).End(xlUp).Offset(1)
Sheets("Sheet5").Range("A:A").Cells(Rows.Count).End(xlUp).Offset(1).Value2 = "+"
Next rngCell
Sheets("Sheet4").Cells.AutoFilter
End Sub
if u cannot specify the range then have to activated sheet3 then its works refer below:
ThisWorkbook.Worksheets("Sheet3").Activate
If ActiveCell = "" Then
Exit Do
End If
Your selection will not change if you are not changing the cell by using .select in the code and therefore will likely result in infinite loop. But using .select in the code is not considered as good practice as it slows down the process.
I'd suggest using For...each Loop like below.
Dim rng as Range
For each rng in selection
If Len(rng.Value) = 0 then Exit Sub '\\ Exit at first blank cell
'\\ Do process here
Next rng
selection can contain 1 or more cells. If you want to check if all the cells in the selection are empty you can use the worksheet function countblank which returns the number of empty cells. If the number of empty cells in the selection equals the number of cells in the selection then all the cells in the selection are empty. your test can be adapted like this
If Application.WorksheetFunction.CountBlank(Selection) = Selection.Count Then Exit Do
Your solution is here.
Credits to mvptomlinson from MrExcel.com
The right code is
'Your code to loop through copying sheets
If ActiveSheet.Range("A1").Value = "" Then Exit Sub
'Your code to continue if A1 isn't empty
Apologies for the potentially very easy to answer question. I was trawling through some code on the site regarding how you search for a row and paste it in another worksheet, the code being the one below:
Sub Test()
For Each Cell In Sheets(1).Range("J:J")
If Cell.Value = "131125" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next
End Sub
I was wondering what the "Cell" should be declared as, as in:
Dim Cell As ...
I'm aware that without "Option Explicit", this is irrelevant, but I'm curious nonetheless, so please do help and explain if you can.
Thank you for your help in advance :)
In your case, cell is a range, so
dim cell as range
And: Always use Option Explicit
Walking over a Range yields a Range so Dim Cell As Range
If in doubt ask VBA: msgbox TypeName(Cell)
You can use Range. They are somewhat interchangeable.
Sorry but that is horrible code and it offends the eyes. Find would be better, but just in the interest of better understanding
Sub Test()
Dim Cell as Range
For Each Cell In Sheets(1).Range("J:J")
If Cell.Value = "131125" Then
Cell.EntireRow.copy Destination:=Sheets("Sheet2").range("a" & cell.row)
'You might want to exit here if there's only one value to find with
'Exit For
End If
Next
End Sub
I use this code to apply a length formula and then Autofill till the last visible cell but getting an error
Runtime Error '1004'- Method 'Range' of object_Global' failed
Code
Range("C2").Select
ActiveCell.FormulaR1C1 = "=LEN(RC[-1])"
Selection.AutoFill Destination:=Range("C2:C" & Lastrow).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
from your code it seems you want the length of cells in COl B. The below code works for me.
Sub x()
Range("C2:C" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=LEN(RC[-1])"
End Sub
As always it's better to stay away from Select, ActiveCell and Selection.
Try the code below:
Dim FitRng As Range, Lastrow As Long
Range("C2").FormulaR1C1 = "=LEN(RC[-1])"
Set FitRng = Range("C2:C" & Lastrow).SpecialCells(xlCellTypeVisible)
FitRng.FillDown
If you don't want to use the FillDown method, you can simply use:
FitRng.FormulaR1C1 = "=LEN(RC[-1])"
I have been looking at this for 5+ hours not being able to find a correct solution. This isn't my main deal just what I do in work to help out.
Basically I am copying from a sheet that has filtered rows to another sheet and placing it at the last row in column A to paste.
This worked perfectly find before I did some changes and now it's completely broken, any help be gratefully appreciated, here is the broken lump of spaghetti code....
Sheets("Working Sheet").Select
Selection.Copy
Sheets("Sent Items").Select
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
Range("A" & LastRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("K:K").EntireColumn.AutoFit
Sheets("Sent Items").Select
It causes an error 1004 saying the size needs to be the same??? The paste causes the error. Any help is good have been looking for the answer.
you could refactor your code as follows:
Worksheets("Working Sheet").Select
Selection.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sent Items").Cells(Rows.Count, 1).End(xlUp).Offset(1)
or, if you are interested in pasting values only:
Dim area As Range
Worksheets("Working Sheet").Select
For Each area In Selection.SpecialCells(xlCellTypeVisible).Areas
Worksheets("Sent Items").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(area.Rows.Count, area.Columns.Count).Value = area.Value
Next area
Since you are copying filtered rows, it's always a good practice to use the SpecialCells method.
See the refactored code below. Also, always best to avoid using select and work directly with objects.
Dim wsWorking as Worksheet
Set wsWorking = Sheets("Working Sheet")
With wsWorking
.Select
Selection.SpecialCells(xlCellTypeVisible).Copy
End With
Dim wsSent as Worksheet
Set wsSent = Sheets("Sent Items")
With wsSent
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow).PasteSpecial
.Columns("K:K").EntireColumn.AutoFit
.Range("A1").Select 'to make sure you end up on that sheet
End With
I have a userform that has a drop down box in which a person can select a record to have deleted off a list.
The code below is deleting the ENTIRE ROW. I do not want that. I just want the cells between A:E cleared on my spreadsheet.
I am not sure how else to describe this so I apologize in advance. Here is the code:
Private Sub CheckBox1_Click()
End Sub
Private Sub CommandButton1_Click()
Dim lRw As Long
ActiveWorkbook.Sheets("RAWDATA").Visible = xlSheetVisible
'get the row number. add 2 because ListIndex starts at one
lRw = Me.ComboBox1.ListIndex + 2
ActiveWorkbook.Sheets("RAWDATA").Select
Cells(lRw, 1).EntireRow.ClearContents
ActiveWorkbook.Sheets("RAWDATA").Visible = xlSheetHidden
End Sub
Private Sub CommandButton2_Click()
ComboBox1.Value = ""
ComboBox1.Clear
ComboBox1.Clear
Unload Me
End Sub
Private Sub UserForm_Initialize()
'assumes data starts in A1 and has a header row
Me.ComboBox1.List = ActiveWorkbook.Sheets("RAWDATA").Cells(1, 2).CurrentRegion.Offset(1, 2).Value
End Sub
side note: You don't need to select the cells to manipulate the contents in vba.
Check out this link to explain that concept in more detail:
how-to-avoid-using-select-in-excel-vba-macros
This is the problem code. You are clearing the entire row, using ".EntireRow.ClearContents"
ActiveWorkbook.Sheets("RAWDATA").Select
Cells(lRw, 1).EntireRow.ClearContents
ActiveWorkbook.Sheets("RAWDATA").Visible = xlSheetHidden
Here are three solutions. Both should give you some insight into how the .Cells(row,col) idea works while using a loop. You are using a variable to control the row number, and the same concept can be applied to the column. Even though it's just 5 columns. It might be 50 for another project. So you can loop through them using a "For Loop" This is my preferred method.
If you want to get loopy, try something like this. Use a Variable for the Column
For lCol = 1 To 5
Sheets("RAWDATA").Cells(lRw, lCol).ClearContents
Next lCol
You can do one cell at a time Directly coding the column number:
Sheets("RAWDATA").Cells(lRw, 1).ClearContents
Sheets("RAWDATA").Cells(lRw, 2).ClearContents
Sheets("RAWDATA").Cells(lRw, 3).ClearContents
Sheets("RAWDATA").Cells(lRw, 4).ClearContents
Sheets("RAWDATA").Cells(lRw, 5).ClearContents
You can do one cell at a time Directly coding the column LETTER:
Sheets("RAWDATA").Cells(lRw, "A").ClearContents
Sheets("RAWDATA").Cells(lRw, "B").ClearContents
Sheets("RAWDATA").Cells(lRw, "C").ClearContents
Sheets("RAWDATA").Cells(lRw, "D").ClearContents
Sheets("RAWDATA").Cells(lRw, "E").ClearContents
edit: added some explanation and link
The cells(lRw, 1).EntireRow.ClearContents is your issue. The EntireRow function selects the row which is pointed to by cells(lRw, 1). The .ClearContents function clears what's selected. You should replace it with something like:
Range("A" & <the row number> & ":J" & <the row number>).clearcontents
Your variable lRw is supposed to hold the value of the row in which the selected project is located, correct? If so, then:
Range("A" & lRw & ":J" & lRw ).clearcontents
should work. You can change the column letters to whatever you'd like to clear.
I think PJ Rosenburg's solutions are bit impractical, but I agree with the fact that you should shy away from using the .select function. You can do everything you need to do without using it. You'll write much better code once you understand this concept. In fact, here's a rewrite of your commandButton1_click that should do the exact same thing, but with less code and is easier to read.
Private Sub CommandButton1_Click()
Dim lRw As Long
lRw = Me.ComboBox1.ListIndex + 2
with ActiveWorkbook.Sheets("RAWDATA")
.Visible = xlSheetVisible
.Range("A" & lRw & ":J" & lRw ).clearcontents
.Visible = xlSheetHidden
end with
end sub
Notice a couple of things:
No .select
Moving the assignment statement
The addition of the With/End With statements
Anyway, I hope this helps and better explains what I was trying to say earlier.