stop VBA code if condition not found

FROGGER24

Well-known Member
Joined
May 22, 2004
Messages
704
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
Looking in column C I am using autofilter to find duplicates then print out sheet, will need to continue printing until condition not found

<ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A1"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A2"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A3"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A4"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A5"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A6"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A7"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A8"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A9"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.Range("$B$13:B" & Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="A10"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False>

thanks for your time.
 
Put in this line the sheet name
Code:
 Set ws = Sheets("Lab Test")
I hope the sheets have the same structure
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
I modified the code to suit my needs:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = Sheets("Lab Data")
With CreateObject("scripting.dictionary")
For Each Cl In ws.Range("C11", ws.Range("C" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Empty
Next Cl

For Each Ky In .Keys
ws.Range("A10").AutoFilter 2, Ky
ws.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Next Ky
End With
ws.ShowAllData

Only modification need is to print only the visible Aliquot# in Column C
 
Last edited by a moderator:
Upvote 0
Again. What you want is to filter the data in the "Lab Test" sheet, with the formulas that you have in the "Lab Data" sheet, the information in the "Lab Data" sheet is updated and then the "Lab Data" sheet is printed. If so, then try this:

Code:
Sub Test()
    Dim ws As Worksheet
    Set ws = Sheets("Lab Test")
    With CreateObject("scripting.dictionary")
        For Each Cl In ws.Range("C2", ws.Range("C" & Rows.Count).End(xlUp))
            .Item(Cl.Value) = Empty
        Next Cl
        For Each Ky In .Keys
            ws.Range("A1").AutoFilter 3, Ky
            Sheets("Lab Data").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        Next Ky
    End With
    ws.ShowAllData
End Sub
 
Upvote 0
We have most of it worked out. Currently the code will print out 1 page with no lab data listed. When I manually go into C10 and uncheck "Blanks" in the autofilter the code works as needed. Is the way to not print blank cells (Cells contain formulas)
 
Upvote 0
If you have empty cells in the "Lab Test" sheet, simply delete those rows and the empty cells will not be printed.
Check row 1992 on the "Lab Test" sheet
 
Upvote 0
Dante, sorry for delay in getting back to you. In my test I selected 000540_M on Lab Data cell "A10"(results are 16 test options) in cell C10 I unchecked "blanks", and in cell E10 I uncheck "false" (results are 8 test options need for required analysis). The expected results would be 5 pages with required aliquot#. I think the code is printing out a page even for the aliquots not required for analysis. Can the code be modified to only print pages with lab data and if column E it true. Basically need to print visible cells only.

Thanks..
 
Upvote 0
Do not print the sheets. Remove this instruction:
Code:
Sheets("Lab Data").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False



And it executes the step by step macro (F8) and it checks at what moment it is not doing the correct filtering or what information is not being copied correctly, and then you tell me what problem it has and I will fix it one by one.
 
Upvote 0
Dante, the code is running as intended to print out a sheet for each unique Aliquot found in column C. I also have auto filter in column E which get filtered to "True". I would like the code to look at column E and column C. If column E equals True then print that aliquot series found in column C, if not go to next key.


sorry for all the rework
 
Last edited by a moderator:
Upvote 0
You can put an image of that. I suppose that several records of a single alicuot can have true and another false, so what is done in those cases?
 
Upvote 0
Dante, I added a worksheet and copied all of the "True" on that spreadsheet I have copied the code here. if there is a more efficient way I am open to using that method
Application.ScreenUpdating = False
Dim wsd As Worksheet 'Lab Data
Dim WSR As Worksheet 'Print Sheet

Set wsd = Worksheets("Lab Data")
Set WSR = Worksheets("Print Sheet")


wsd.Range("$B$10:$E$50").AutoFilter Field:=2, Criteria1:="<>"
wsd.Range("$B$10:$E$50").AutoFilter Field:=4, Criteria1:="TRUE"
wsd.Range("A1:E" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy


WSR.Range("A1").PasteSpecial Paste:=xlPasteValues
WSR.Range("A1").PasteSpecial Paste:=xlPasteFormats

WSR.Cells.EntireColumn.AutoFit

With WSR.PageSetup
.CenterHeader = "&26Docks Sample Registration Form"
.CenterHorizontally = False
.CenterVertically = True
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

With CreateObject("scripting.dictionary")
For Each Cl In WSR.Range("C11", WSR.Range("C" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Empty
Next Cl
For Each Ky In .Keys
WSR.Range("A10").AutoFilter 3, Ky
Sheets("Print Sheet").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Next Ky
End With


wsd.ShowAllData
WSR.ShowAllData
WSR.Cells.Delete Shift:=xlUp

wsd.Activate

Application.ScreenUpdating = True
 
Upvote 0

Forum statistics

Threads
1,214,991
Messages
6,122,628
Members
449,095
Latest member
bsb1122

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