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
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