ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Stop code from running when I click "Cancel" (https://www.excelbanter.com/excel-programming/354798-stop-code-running-when-i-click-cancel.html)

Dean[_9_]

Stop code from running when I click "Cancel"
 
I have a small issue with this code. While running the code the "Input
box" appears and when I click cancel the code still excecutes and
copies everything on the "database" page to the "found page".

I would value some ideas on how to stop the code from executing when I
click "cancel" on the Input box.

Thanks,
Dean


Sub Macro2()
Dim LastRow As Long, MyCriteria, _
rCriteriaField As Range, rPointer As Range, rCopyTo As Range

' This variable has the value of the criteria by which you intend
' to select records to extract. Lets assume you are evaluating
' the entries in column A of your source table. This can be either
' text or numeric.
MyCriteria = InputBox("Enter Dept Code")

' Initialize a variable for the last possible record in a worksheet
If Left(Application.Version, 1) < 8 Then _
LastRow = 5700 Else LastRow = 65536

With ThisWorkbook

' Initialize a range object variable for the entire populated
' area of column B (excluding row 1 for a header)
With Worksheets("database")
Set rCriteriaField = .Range(.Cells(2, 2), _
.Cells(Application.Max(2, _
.Cells(LastRow, 1).End(xlUp).Row), 1))
End With

Set rCopyTo = .Worksheets("found").Cells(2, 1)
End With

' Loop through all the records in your source data table
For Each rPointer In rCriteriaField
With rPointer

' If there is a match on the criteria in col A then copy
' the record to the destination table
If InStr(1, .Value, MyCriteria) 0 Then
.Resize(, 8).Copy
rCopyTo.PasteSpecial xlPasteValues

' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTo.Offset(1, 0)
End If
End With
Next rPointer
End Sub


davesexcel[_29_]

Stop code from running when I click "Cancel"
 

the code in the cancel button should read
exit sub


--
davesexcel
------------------------------------------------------------------------
davesexcel's Profile: http://www.excelforum.com/member.php...o&userid=31708
View this thread: http://www.excelforum.com/showthread...hreadid=518057


Haldun Alay

Stop code from running when I click "Cancel"
 
after the line

MyCriteria = InputBox("Enter Dept Code")

add this

If MyCriteria = "" Then Exit Sub

after adding this line, when you execute the code and press cancel button (or press OK button while the inputbox is empty) , it will stop the execution of rest of the code.

--
Haldun Alay
"Dean" , haber iletisinde sunlari roups.com...
I have a small issue with this code. While running the code the "Input
box" appears and when I click cancel the code still excecutes and
copies everything on the "database" page to the "found page".

I would value some ideas on how to stop the code from executing when I
click "cancel" on the Input box.

Thanks,
Dean


Sub Macro2()
Dim LastRow As Long, MyCriteria, _
rCriteriaField As Range, rPointer As Range, rCopyTo As Range

' This variable has the value of the criteria by which you intend
' to select records to extract. Lets assume you are evaluating
' the entries in column A of your source table. This can be either
' text or numeric.
MyCriteria = InputBox("Enter Dept Code")

' Initialize a variable for the last possible record in a worksheet
If Left(Application.Version, 1) < 8 Then _
LastRow = 5700 Else LastRow = 65536

With ThisWorkbook

' Initialize a range object variable for the entire populated
' area of column B (excluding row 1 for a header)
With Worksheets("database")
Set rCriteriaField = .Range(.Cells(2, 2), _
.Cells(Application.Max(2, _
.Cells(LastRow, 1).End(xlUp).Row), 1))
End With

Set rCopyTo = .Worksheets("found").Cells(2, 1)
End With

' Loop through all the records in your source data table
For Each rPointer In rCriteriaField
With rPointer

' If there is a match on the criteria in col A then copy
' the record to the destination table
If InStr(1, .Value, MyCriteria) 0 Then
.Resize(, 8).Copy
rCopyTo.PasteSpecial xlPasteValues

' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTo.Offset(1, 0)
End If
End With
Next rPointer
End Sub


Dean[_9_]

Stop code from running when I click "Cancel"
 
Thanks Gents. That did the trick.



All times are GMT +1. The time now is 12:46 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com