Stop macro if criteria does not met (exit sub)

Hudson Andrew

New Member
Joined
Sep 28, 2016
Messages
31
Hi all ,

I have macro that does quick filter on column "N" and look for the dollar value >=5000
and copy the records and past in next sheet , now i wanted is if my filter column does not have dollar value of >=5000
macro should terminate .

below is the macro for your refernce .

Code:
Sub sixtydays()'
' sixtydays Macro
'
 
'
    Range("M1").Select
    Selection.AutoFilter
    Range("N1").Select
    ActiveSheet.Range("$A$1:$P$904").AutoFilter Field:=14, Criteria1:=">=5000" _
        , Operator:=xlAnd
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Previous.Select
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
    ActiveSheet.Previous.Select
    ActiveSheet.Previous.Select
    ActiveSheet.Previous.Select
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
   Range("A1").Select
End Sub


any inputs are appricated .
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Try this:

Code:
Sub sixtydays()'
' sixtydays Macro
'
 
'
If Application.WorksheetFunction.Max(Range("$N$1:$N$904")) >= 5000 Then
    Range("M1").Select
    Selection.AutoFilter
    Range("N1").Select
    ActiveSheet.Range("$A$1:$P$904").AutoFilter Field:=14, Criteria1:=">=5000" _
        , Operator:=xlAnd
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Previous.Select
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
    ActiveSheet.Previous.Select
    ActiveSheet.Previous.Select
    ActiveSheet.Previous.Select
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
   Range("A1").Select
   Else:
       Msgbox("No dollar values over 1000")
   End if
End Sub

I'd probably use a different range than N904 as the ending range...maybe more like N1048576.end(xlup). But I don't know what your spreadsheet looks like.
 
Last edited:
Upvote 0
Hello, this method is slightly more elegant than the recorded macro. It uses a loop rather than working the autofilter. If no values match the criteria (>= 5000), then nothing will get copied.

Code:
Public Sub FilterData()
  Dim rngIterator As Range
  Dim lngNextRow As Long
  Dim wksSource As Worksheet
  Dim wksTarget As Worksheet
  Dim rngSource As Range
  
  On Error GoTo ErrHandler
  Set wksSource = ThisWorkbook.Sheets("Source") '<-- change sheet name
  Set wksTarget = ThisWorkbook.Sheets("Target") '<-- change sheet name
  
' Source is the sheet containing your values to copy.
' Target is the sheet you want to paste the values >= 5000.
  
  Intersect(wksTarget.UsedRange, wksTarget.Columns("A:P")).Clear
  wksTarget.Range("A1:P1").Value = wksSource.Range("A1:P1").Value
  Set rngSource = Intersect(wksSource.UsedRange, _
                            wksSource.Range("N2:N" & _
                            wksSource.Rows.Count))
  lngNextRow = 2
  For Each rngIterator In rngSource
    If IsNumeric(rngIterator.Value) _
    And Not IsEmpty(rngIterator.Value) Then
      If rngIterator.Value >= 5000 Then
        Intersect(rngIterator.EntireRow, wksSource.Columns("A:P")).Copy
        wksTarget.Cells(lngNextRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
        lngNextRow = lngNextRow + 1
      End If
    End If
  Next rngIterator
  
  wksTarget.Columns("A:P").AutoFit
  MsgBox Format(lngNextRow - 2, "#,##0") & " rows were copied.", vbInformation

ExitProc:
  Application.CutCopyMode = False
  Set rngIterator = Nothing
  Set wksSource = Nothing
  Set wksTarget = Nothing
  Set rngSource = Nothing
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitProc
End Sub
 
Upvote 0
^^^ Mr. Fancy pants shows up with his well-to-do error handling. In all seriousness, that's some pretty solid writing. I wish I had the discipline to write error handling procedures and actually reset my variables. It would save me more time than it's cost.
 
Upvote 0
Joe and Ray - it was a great advice from you . and sorry for the late come back . both of your methods helped a lot . thanks for your assistance.
 
Upvote 0
Ray - i have one quick question - i am just trying to understand the code and thought you can take me through the code . so my question is it was observed from the above code that you did not declared any variables for the methods ( rngIterator ) . so this i will works can you please help me .
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,326
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top