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
Related
Saved a Macro where I would go to to the last non-empty cell in a row by using CTRL+Right Arrow.
The macro, however, was saved by logging the J23 cell.
I want it to be dynamic so that if last non-empty cell changes, for instance, it is N23, it jumps there.
I would like that my other steps would then always link to cells L30, M30, N30 and O30 but in this case they are using relative coordinates (I tried to edit the macro from J23 to N23, for instance, and the linked cells change)
What are the code lines that I can use to make it dynamic the way I need?
Thank you for your help
Sub KPILinks()
'
' KPILinks Macro
'
'
Range("I22").Select
Selection.End(xlToRight).Select
Range("J23").Select
ActiveCell.FormulaR1C1 = "=R[7]C[2]"
Range("J24").Select
ActiveCell.FormulaR1C1 = "=R[6]C[3]"
Range("J25").Select
ActiveCell.FormulaR1C1 = "=R[5]C[4]"
Range("J26").Select
ActiveCell.FormulaR1C1 = "=R[4]C[5]"
Range("J27").Select
End Sub
borrowed from https://www.rondebruin.nl/win/s9/win005.htm
Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox LastRow
End Sub
I'm trying to store values in sheets as a variable, and then go on to reference a sheet using that variable as well as use it to filter by.
This will be looped through until the program reaches the first empty cell.
The relevant code I have so far is:
Sub Program()
Dim i As Integer
i = 2
Do Until IsEmpty(Cells(i, 1))
Debug.Print i
Sheets("Button").Activate
Dim First As String
First = Cells(i, 1).Value
Debug.Print First
Dim Second As String
Second = Cells(i, 2).Value
Debug.Print Second
'Filters my Data sheet and copies the data
Sheets("DATA").Activate
Sheets("DATA").Range("A1").AutoFilter _
Field:=2, _
Criteria1:=First 'Filters for relevant organisation
Sheets("DATA").Range("A1").AutoFilter _
Field:=6, _
Criteria1:="=" 'Filters for No Response
Sheets("DATA").Range("A1:H6040").Copy
'This should loop through for each separate group
Sheets(CStr(Second)).Select
Range("A1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
Loop
Worksheets("DATA").AutoFilterMode = False
End Sub
I have changed the program significantly trying to add notation such as 'CStr' as there was an error at this line:
Sheets(CStr(Second)).Select when it used to say Sheets(Second)).Select
and the debug.print's to see if it is actually working but it isn't logging to the Immediate Window.
Additionally, when I actually run it, no error comes up but nothing seems to happen.
Not sure what else to add, or what else to try. Cheers!
As a first remark, using (at least the first) sheet activation within the loop seems unnecessary, because the start of the loop is what determines which sheet is being used to control the flow of the loop.
Furthermore, I would argue that it is better to remove the sheet activation altogether, re: the discussion about .Select (the cases aren't the same, but the solution discussed herein works better for both .Select and .Activate in almost all instances): How to avoid using Select in Excel VBA macros.
Let's also see if we can refer to the table in the "DATA" sheet in a more direct manner, as well as do some errorchecking.
My suggestion:
Sub Program()
Dim i As Integer
Dim First, Second As String
Dim secondWs As Worksheet
Dim dataTbl As ListObject
i = 2
Set dataTbl = Worksheets("DATA").Range("A1").ListObject.Name
' The above can be done more elegantly if you supply the name of the table
Sheets("DATA").Activate
Do Until IsEmpty(Cells(i, 1))
Debug.Print i
First = Sheets("Button").Cells(i, 1).Value
Debug.Print First
Second = Sheets("Button").Cells(i, 2).Value
Debug.Print Second
'Filters my Data sheet and copies the data
dataTbl.AutoFilter _
Field:=2, _
Criteria1:=First 'Filters for relevant organisation
dataTbl.AutoFilter _
Field:=6, _
Criteria1:="=" 'Filters for No Response
Sheets("DATA").Range("A1:H6040").Copy
'This should loop through for each separate group
On Error Resume Next
Set secondWs = Worksheets(Second)
On Error GoTo 0
If Not secondWs Is Nothing Then
secondWs.Range("A1").PasteSpecial Paste:=xlPasteValues
Else
Debug.Print "Sheet name SECOND was not found"
End If
i = i + 1
Loop
Worksheets("DATA").AutoFilterMode = False
End Sub
If you get any errors, please state which line it appears on and what the error message actually is.
Ref:
http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html#post13739
I'm automating a process to import data from a worksheet, though for data integrity (and to eventually append to a database), I do not want the identifier entered twice. My code works to import the data if the identifier (SHC_No) is not in column A, and to prompt if you would like to replace the entries because something has changed. It will delete the entries, and find the next blank row, but the .paste function will not operate. (Even though it is on the cell I want to paste into and I can see the data in the clipboard.)
I have gotten Run Time Error 1004 "Paste method of worksheet class failed," and "PasteSpecial Method of Range class failed," as well as 438 "Object doesn't support this property or method."
I'm relatively new to Excel VBA. I have tried different variations of .paste and .pastespecial and nothing seems to work. I have tried With statements, and defining the range. I'm at a loss.
Any ideas or suggestions, would be greatly appreciated.
Sub ImportAPDR()
Dim wbImport As Workbook
Dim wbCurrent As Workbook
Dim strSHC As String
Set wbImport = Workbooks("ImportPhase2.xlsm") 'Ensure name of the workbook... and don't change it.
Set wbCurrent = ActiveWorkbook
'On Error GoTo Handler:
Application.ScreenUpdating = False 'Prevents flickering screen.
'Activate Page 3 of the APDR
Worksheets("Page 3").Activate
strSHC = Range("A11").Value
Range("A11").Activate
Do
If ActiveCell.Value = "" Then Exit Do
ActiveCell.Offset(1, 0).Activate
Loop
'Selects All data from A11 until the EOR
ActiveCell.Offset(-1, 12).Activate
Range("A11", ActiveCell).Select
Selection.Copy
'Find the first blank cell in the Import workbook.
wbImport.Activate
Worksheets("Import").Activate
FindSHC (strSHC) 'Must send a variable or the other subroutine will not work.
Application.ScreenUpdating = True
Exit Sub
'Handler:
'MsgBox ("Ensure to run the macro on the APDR workbook, not the import workbook.")
End Sub
Sub FindSHC(strSHC As String)
Dim foundSHC As String
Dim Rng As Range
Dim StartRange As Range
Dim PasteRng As Range
FindString = strSHC
If Trim(strSHC) <> "" Then
With Sheets("Import").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Rng Is Nothing Then
Range("A1").Activate
Do
If ActiveCell.Value = "" Then Exit Do
ActiveCell.Offset(1, 0).Activate
Loop
ActiveSheet.Paste
Application.CutCopyMode = False
MsgBox ("The Tenant/Unit Details have been copied for import.")
Else
Application.Goto Rng, True
Set StartRange = ActiveCell
Answer = MsgBox("This APDR looks like it has already been imported." & vbNewLine & "Do you want to reimport and replace?", vbYesNo)
If Answer = vbYes Then
'Finds the values that have previously been entered and loops to select them all for deletion.
Do
If ActiveCell.Value <> strSHC Then Exit Do
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Offset(-1, 0).Activate
Range(StartRange, ActiveCell).Select
Selection.EntireRow.Delete Shift:=xlUp
'Find the next open row
Range("A1").Activate
Do
If ActiveCell.Value = "" Then Exit Do
ActiveCell.Offset(1, 0).Activate
Loop
ActiveSheet.Paste '<-----This is where I get my error.
Application.CutCopyMode = False
MsgBox ("The Tenant/Unit Details have been replaced.")
Else
Application.CutCopyMode = False
MsgBox ("Import has been cancelled.")
End If
End If
End With
End If
End Sub
Here are some tips to avoid getting stuck in such moments.
Always try to emulate what macro does by manually performing all the actions, wherever it is possible to. In your case you can choose 2 identifiers for QA - one which is not present and another which is present. You won't have any trouble with the first one, but with the second - as soon as you delete any cell content after you have copied some range, your selection and copied range would be lost from clipboard. And that's actually what makes a trouble.
Do proper debugging. As soon as you go into strange exception - debug what brought your code to this point. And again - in your case you can see that as soon as you delete contents the "dashed border" around copied range will disappear, meaning you have no copied range anymore which you could paste.
This one goes directly to copy-paste combination. Whenever you are in need to use Copy & Paste build up your code so that these two go one after another. Avoid any range interaction between these two functions. If you need to do some calculations just save the range parameters(like range rectangle dimensions, starting row+column, ending row+column) to other variables and Copy only when you've done with everything using those saved parameters.
Good luck with this one.
I am trying to make a macro that selects certain data in my sheet. I have a sheet with data that is pulled into it using:
Windows("Item checkout workbook_New.xlsx").Activate
Range("A2:G300").Select
Selection.Copy
Windows("VLookup test.xlsx").Activate
Sheets("Sheet1").Select
Range("A2:G2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Sheet1").Range("A2:G300").Copy Sheets("Sheet2").Range("A2")
Sheets("Sheet2").Select
Application.CutCopyMode = False
Once this data is input, I have two columns H2:H300 and I2:I300 that has formulas already in it for Vlookup that get information from A2:G300.
What I then need to do is select only the relevant data and copy it back to Windows("Item checkout workbook_New.xlsx"). By relevant data, I need to select only cells with data in the A2:G300 range as well as the H2:I300 cells that match. Seeing as ALL H2:I300 cells have data, I am not sure how to do this. I tried to create a macro that uses END to select all of column A and then the rows that go with it, but this is what I got and as you can see it will not work:
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:I78").Select
Selection.Copy
I am not great at VBA thus it is hard to come up with things on the fly, but I feel like there should be a way to get this to work. Any advice would be great!
Range("A2").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Select
Selection.Copy
Windows("Item checkout workbook_New.xlsx").Activate
Sheets("Sheet1").Select
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Got it working!
Based off your own answer, it seems I may have misinterpreted your question. What I gathered was that you were looking for a way to select relevant cells in a worksheet. The relevant cells could belong to one of two ranges. In one range, cells that are not empty should be selected. In the other range, cells that match a value should be selected. (you can just add in your copy/paste code)
I solved that problem below.
Sub test()
'store results here
Dim result As Range
setupTest
'check this range and return items that are not empty
selectMatchingCells Range("A1:D1"), result
'check this range and return items that match value
selectMatchingCells Range("B2:C4"), result, "hi"
result.Select
End Sub
Function setupTest()
Range("A1").Value = "anything"
Range("c1").Value = "may go"
Range("D1").Value = "here"
Range("B2").Value = "hi"
Range("B3").Value = "but not here"
End Function
Function selectMatchingCells(search As Range, result As Range, Optional searchValue As String = "")
For Each cell In search
'are we checking that cell value matches string, or if cell has a value at all?
If searchValue = vbNullString Then
'check if cell is not empty
If IsEmpty(cell) = False Then selectCell result, cell
Else
'check if value matches
If cell.Text = searchValue Then selectCell result, cell
End If
Next cell
End Function
Function selectCell(result As Range, cell As Variant)
'check if result range already exists or not
If result Is Nothing Then
'make range equal to cell
Set result = cell
Else
'add cell to existing range
Set result = Union(result, cell)
End If
End Function
Please be more clear to avoid miscommunication, thanks!
I have 3 Sheets: Work, Bill, and Cust. Cust column A contains my unique customers, which I then paste onto cell A3 on the Work sheet where it runs its calculations and then paste it on to the Bill sheet. I then take the next value on the Cust sheet and i paste it back to Work, run the calculation and paste it below the previous set on the Bill sheet. I have 2 questions.
Why isn't my loop working? I'm trying to keep going until I run out of customers on the cust sheet?
Why is it that I can use the custom range BillPlace in the first part of my code, yet I actually have to refer to the cells in the later parts?
Thanks in advance
Sub test1()
Dim WorkPlace As Range, BillPlace As Range, WorkProd As Range
Set WorkPlace = Sheets("Work").Cells(3, 1)
Set BillPlace = Sheets("Bill").Cells(3, 1)
Set WorkProd = WorkPlace.CurrentRegion
WorkPlace.CurrentRegion.Copy
BillPlace.PasteSpecial xlPasteAll
Sheets("Cust").Select
Cells(1, 1).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("Bill").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Sheets("Cust").Select
Cells(2, 1).Select
Selection.Offset(1, 0).Select
Do
ActiveCell.Offset(1, 0).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("Bill").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Loop Until IsEmpty(ActiveCell.Offset(1, 0))
End Sub
#Portland Runner has a point about using a For Each / Next loop. By doing that you can probably eliminate the counters and a bunch of selecting from your working code above, removing a bunch of complexity from your process.
The principle of a For/Next loop is easy enough: define TheLargerRange containing the cells you will loop through. Define a SingleCell range to contain the current cell you are working with. Then you can start the loop saying something like:
For Each SingleCell in TheLargerRange
'~~> your loop actions go here
Next SingleCell
Also, you can do a lot without selecting specific locations in your workbook. Instead copy, paste, or assign values by just referencing the location. If you want, you can set variables to make this easier in longer code.
The following example just moves a column of customer data from one sheet to another, as an example of how to use the For Each / Next loop structure and how to avoid selecting everything you work with. There is only one selection in this code, and that is only because the compiler chokes if you use End(xldown) to attempt setting a range on an unselected tab. Otherwise there could be no selections.
Sub UsingForNextAndAvoidingSelections()
'~~> Set variables for referencing the "Cust" tab
Dim CustomerList As Range
Dim Customer As Range
Dim CustomerTab As Worksheet
Set CustomerTab = Sheets("Cust")
CustomerTab.Select
Set CustomerList = CustomerTab.Range("A1", Range("A1").End(xlDown))
'~~> Set variables for referencing the "Bill" tab
Dim BillTab As Worksheet
Dim BillRow As Range
Set BillTab = Sheets("Bill")
Set BillRow = BillTab.Range("A1")
'~~> Loop through the customer list, copying each value to the new BillRow location
For Each Customer In CustomerList
Customer.Copy
BillRow.PasteSpecial xlPasteAll
Set BillRow = BillRow.Offset(1, 0)
Next Customer
End Sub
12/27/2013: I just realized why the code Set CustomerList = CustomerTab.Range("A1", Range("A1").End(xlDown)) was throwing an error when CustomerTab was not selected: I forgot to fully qualify the second range statement in that line: Range("A1").End(xlDown).
I believe that if you qualify that line of code like this Set CustomerList = CustomerTab.Range("A1", CustomerTab.Range("A1").End(xlDown)) you can eliminate the CustomerTab.Select that precedes it and conduct the entire process without a single Select.
WorkProd.Copy
Sheets("Bill").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Loop Until IsEmpty(ActiveCell.Offset(1, 0))
You are going to the end of a column and pasting one row further down. You then check if the cell one row further down is empty, but it won't be because you've just pasted into it. This is why it repeats endlessly.
I assume you should be looking for an empty cell somewhere other than one row below the current cursor position.
HA! i fixed it. This isn't the most orthodox approach but it worked. Oh pardon me but i did it in production so the name of the sheets and cell positions changed slightly. CountC is a helper cell that counts the number of customers. Thanks everyone for your help.
Sub Pull_Billing()
Dim WorkPlace As Range, BillPlace As Range, WorkProd As Range, PlaceHolder As Range, CountC As Integer, n As Integer
Set WorkPlace = Sheets("Work").Cells(3, 1)
Set BillPlace = Sheets("ABS_Billing_Sheet").Cells(3, 1)
Set WorkProd = WorkPlace.CurrentRegion
CountC = Sheets("CTA_Info").Cells(1, 5).Value
Sheets("CTA_info").Cells(2, 2).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkPlace.CurrentRegion.Copy
BillPlace.PasteSpecial xlPasteAll
Sheets("CTA_Info").Select
Cells(3, 2).Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("ABS_Billing_Sheet").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Sheets("CTA_Info").Select
Cells(4, 2).Select
n = ActiveCell.Row
Do
Cells(n, 2).Select
Selection.Copy
WorkPlace.PasteSpecial xlPasteAll
WorkProd.Copy
Sheets("ABS_Billing_Sheet").Select
Range("A3").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).PasteSpecial xlPasteAll
Sheets("CTA_Info").Select
Cells(n + 1, 2).Select
n = ActiveCell.Row
Loop Until n > CountC + 2
Sheets("CTA_info").Cells(2, 2).Copy
WorkPlace.PasteSpecial xlPasteAll
Sheets("ABS_Billing_Sheet").Select
End Sub