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