Stop code from running when I click "Cancel"

[Dean]

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 = rCopyTffset(1, 0)
End If
End With
Next rPointer
End Sub

 

[davesexcel]

the code in the cancel button should read
exit sub

 

[Haldun Alay]

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" <[email protected]>, haber iletisinde sunlari yazdi:[email protected]...
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 = rCopyTffset(1, 0)
End If
End With
Next rPointer
End Sub

 

[Dean]

Thanks Gents. That did the trick.