VBA macro to search each sheet cell for specific text and print to PDF when true

camerong

New Member
Joined
May 9, 2023
Messages
42
Office Version
  1. 2016
Platform
  1. Windows
Hi guys,

I need urgent help with this VBA code, I have got it searching a cell in each worksheet ("E1"). The issue I am having is that when it gets to a sheet where the cell "E1" does not have the cell text "NO", the code stops and it will not continue on to start searching the next worksheet, it will take me to the very end worksheet of the code. I need it to search each worksheet (2-101) regardless of whether it found the word "NO" in the cell on the previously searched worksheet. The macro button is linked to "Sub Print_all_outstanding()"

Thanks guys

See below:



Public Sub Print_all_outstanding()

Dim cell As Range

Call Print_LOG_Sheet
Call Search_for_NO_2_to_10
'Call Search_for_NO_11_to_20
'Call Search_for_NO_21_to_30
'Call Search_for_NO_31_to_40
'Call Search_for_NO_41_to_50
'Call Search_for_NO_51_to_60
'Call Search_for_NO_61_to_70
'Call Search_for_NO_71_to_80
'Call Search_for_NO_81_to_90
'Call Search_for_NO_91_to_101

End Sub

Sub Print_LOG_Sheet()

Worksheets(1).Select
Call Print_RFI_LOG_sub

End Sub

Function Search_for_NO_2_to_10()

Worksheets(2).Select
Call Search_for_NO

Worksheets(3).Select
Call Search_for_NO

Worksheets(4).Select
Call Search_for_NO

Worksheets(5).Select
Call Search_for_NO

Worksheets(6).Select
Call Search_for_NO

Worksheets(7).Select
Call Search_for_NO

Worksheets(8).Select
Call Search_for_NO

Worksheets(9).Select
Call Search_for_NO

Worksheets(10).Select
Call Search_for_NO

End Function

Sub Search_for_NO_11_to_20()

Worksheets(11).Select
Search_for_NO

Worksheets(12).Select
Search_for_NO

Worksheets(13).Select
Search_for_NO

Worksheets(14).Select
Search_for_NO

Worksheets(15).Select
Search_for_NO

Worksheets(16).Select
Search_for_NO

Worksheets(17).Select
Search_for_NO

Worksheets(18).Select
Search_for_NO

Worksheets(19).Select
Search_for_NO

Worksheets(20).Select
Search_for_NO

End Sub

Sub Search_for_NO_21_to_30()

Worksheets(21).Select
Search_for_NO

Worksheets(22).Select
Search_for_NO

Worksheets(23).Select
Search_for_NO

Worksheets(24).Select
Search_for_NO

Worksheets(25).Select
Search_for_NO

Worksheets(26).Select
Search_for_NO

Worksheets(27).Select
Search_for_NO

Worksheets(28).Select
Search_for_NO

Worksheets(29).Select
Search_for_NO

Worksheets(30).Select
Search_for_NO

End Sub

Sub Search_for_NO_31_to_40()

Worksheets(31).Select
Search_for_NO

Worksheets(32).Select
Search_for_NO

Worksheets(33).Select
Search_for_NO

Worksheets(34).Select
Search_for_NO

Worksheets(35).Select
Search_for_NO

Worksheets(36).Select
Search_for_NO

Worksheets(37).Select
Search_for_NO

Worksheets(38).Select
Search_for_NO

Worksheets(39).Select
Search_for_NO

Worksheets(40).Select
Search_for_NO

End Sub

Sub Search_for_NO_41_to_50()

Worksheets(41).Select
Search_for_NO

Worksheets(42).Select
Search_for_NO

Worksheets(43).Select
Search_for_NO

Worksheets(44).Select
Search_for_NO

Worksheets(45).Select
Search_for_NO

Worksheets(46).Select
Search_for_NO

Worksheets(47).Select
Search_for_NO

Worksheets(48).Select
Search_for_NO

Worksheets(49).Select
Search_for_NO

Worksheets(50).Select
Search_for_NO

End Sub

Sub Search_for_NO_51_to_60()

Worksheets(51).Select
Search_for_NO

Worksheets(52).Select
Search_for_NO

Worksheets(53).Select
Search_for_NO

Worksheets(54).Select
Search_for_NO

Worksheets(55).Select
Search_for_NO

Worksheets(56).Select
Search_for_NO

Worksheets(57).Select
Search_for_NO

Worksheets(58).Select
Search_for_NO

Worksheets(59).Select
Search_for_NO

Worksheets(60).Select
Search_for_NO

End Sub

Sub Search_for_NO_61_to_70()

Worksheets(61).Select
Search_for_NO

Worksheets(62).Select
Search_for_NO

Worksheets(63).Select
Search_for_NO

Worksheets(64).Select
Search_for_NO

Worksheets(65).Select
Search_for_NO

Worksheets(66).Select
Search_for_NO

Worksheets(67).Select
Search_for_NO

Worksheets(68).Select
Search_for_NO

Worksheets(69).Select
Search_for_NO

Worksheets(70).Select
Search_for_NO

End Sub

Sub Search_for_NO_71_to_80()

Worksheets(71).Select
Search_for_NO

Worksheets(72).Select
Search_for_NO

Worksheets(73).Select
Search_for_NO

Worksheets(74).Select
Search_for_NO

Worksheets(75).Select
Search_for_NO

Worksheets(76).Select
Search_for_NO

Worksheets(77).Select
Search_for_NO

Worksheets(78).Select
Search_for_NO

Worksheets(79).Select
Search_for_NO

Worksheets(80).Select
Search_for_NO

End Sub

Sub Search_for_NO_81_to_90()

Worksheets(81).Select
Search_for_NO

Worksheets(82).Select
Search_for_NO

Worksheets(83).Select
Search_for_NO

Worksheets(84).Select
Search_for_NO

Worksheets(85).Select
Search_for_NO

Worksheets(86).Select
Search_for_NO

Worksheets(87).Select
Search_for_NO

Worksheets(88).Select
Search_for_NO

Worksheets(89).Select
Search_for_NO

Worksheets(90).Select
Search_for_NO

End Sub

Sub Search_for_NO_91_to_101()

Worksheets(91).Select
Search_for_NO

Worksheets(92).Select
Search_for_NO

Worksheets(93).Select
Search_for_NO

Worksheets(94).Select
Search_for_NO

Worksheets(95).Select
Search_for_NO

Worksheets(96).Select
Search_for_NO

Worksheets(97).Select
Search_for_NO

Worksheets(98).Select
Search_for_NO

Worksheets(99).Select
Search_for_NO

Worksheets(100).Select
Search_for_NO

Worksheets(101).Select
Search_for_NO

End Sub

Function Search_for_NO()

For Each cell In Range("E1")
If cell.Value = "NO" Then
Print_to_PDF_sub
Else
End If
Next

End Function

Sub Print_RFI_LOG_sub()

SheetName = "RFI RECORD SHEET - "
JobNum = Range("D2") & " - "
JobName = Range("D3")
Exten = ".pdf"
'
Range("A1:H105").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ChDir "C:\Users\" & Environ("Username") & "\Downloads\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\" & Environ("Username") & "\Downloads\" & SheetName & JobNum & JobName & Exten _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=True, OpenAfterPublish:=False
With ActiveSheet.PageSetup
.PrintArea = myRange
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = False
.PaperSize = xlPaperA4
.BlackAndWhite = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True

End Sub

Sub Print_to_PDF_sub()

RFIPrefix = "RFI "
RFINum = Range("E4") & " - "
JobNum = Range("B4") & " - "
JobName = Range("B5")
Exten = ".pdf"
'
Range("A1:E28").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ChDir "C:\Users\" & Environ("Username") & "\Downloads\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\" & Environ("Username") & "\Downloads\" & RFIPrefix & RFINum & JobNum & JobName & Exten _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=True, OpenAfterPublish:=False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = False
.PaperSize = xlPaperA4
.BlackAndWhite = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True

End Sub
 

Attachments

  • Sheet image.png
    Sheet image.png
    43.7 KB · Views: 3

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Hello @camerong.
Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​


If all 101 sheets do not exist, change the 101 to the number of sheets you have or to this instruction:
Rich (BB code):
For i = 2 To Sheets.Count

I think all your code would be reduced to the following.
VBA Code:
Public Sub Print_all_outstanding()
  Dim i As Long
 
  Call Print_RFI_LOG_sub  'Sheet 1
 
  For i = 2 To 101
    If Sheets(i).Range("E1").Value = "NO" Then
      Call Print_to_PDF_sub(i)
    End If
  Next
End Sub

Sub Print_to_PDF_sub(n As Long)
  Dim RFIPrefix As String, RFINum As String, JobNum As String, JobName As String, Exten As String

  RFIPrefix = "RFI "
  RFINum = Sheets(n).Range("E4") & " - "
  JobNum = Sheets(n).Range("B4") & " - "
  JobName = Sheets(n).Range("B5")
  Exten = ".pdf"
  '
  Sheets(n).ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="C:\Users\" & Environ("Username") & "\Downloads\" & RFIPrefix & RFINum & JobNum & JobName & Exten, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
End Sub

Sub Print_RFI_LOG_sub()
  Dim SheetName As String, JobNum As String, JobName As String, Exten As String
 
  SheetName = "RFI RECORD SHEET - "
  JobNum = Sheets(1).Range("D2") & " - "
  JobName = Sheets(1).Range("D3")
  Exten = ".pdf"
  '
  Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="C:\Users\" & Environ("Username") & "\Downloads\" & SheetName & JobNum & JobName & Exten, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
End Sub


--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.
----- --
 
Last edited:
Upvote 0
Solution
Hi Dante,

Thanks for your response, Ive gone and copied that into the excel document. I then ran it and it prints the RFI log sheet correctly, it then goes on to the next sheet (2) which as NO in the cell so prints it to PDF, then it goes to the next sheet (3) which as NO in the cell so prints it to PDF, then it goes to the next sheet (4) which as YES in the cell so it doesn't print it to PDF, but then the next sheet (5) has NO in the cell "E1" but it doesnt get printed as the macro has either stopped or for some reason skips checking the sheets after it cant find NO. It seems as soon as it gets to a situation where the "NO" is missing it stops and wont keep searching through the rest of the workbook sheets.

Hope that makes sense.
 

Attachments

  • RFI Log.png
    RFI Log.png
    91.8 KB · Views: 4
  • Downloads folder.png
    Downloads folder.png
    13.9 KB · Views: 5
Upvote 0
but then the next sheet (5) has NO in the cell "E1" but it doesnt get printed as the macro has either stopped
Please check this:
1. Did you change anything in the macro?
The macro does not stop, the macro continues from sheet 2 to sheet 101.

2. What is different about the sheet (5), is it hidden, is it protected?

3. Sure it says "NO", you already checked if it has spaces before or after: " NO "

4. You could share a copy of your book to review the sheets, to a free site such www.dropbox.com or google drive.
Delete sensitive information. I'm only interested in reviewing the first 6 sheets, to see why you say that the macro stops at sheet 5.

5. In your pictures I can't see how many sheets you have. Are you sure you have more than 5?

6. Or maybe the file names are the same and so instead of having 4 files you have a file that has been overwritten 4 times.
Let's add a counter to the file name to check the files created. Try this:
Rich (BB code):
Public Sub Print_all_outstanding()
  Dim i As Long
 
  Call Print_RFI_LOG_sub  'Sheet 1
 
  For i = 2 To Sheets.Count
    If Sheets(i).Range("E1").Value = "NO" Then
      Call Print_to_PDF_sub(i)
    End If
  Next
End Sub

Sub Print_to_PDF_sub(n As Long)
  Dim RFIPrefix As String, RFINum As String, JobNum As String, JobName As String, Exten As String
  RFIPrefix = "RFI "
  RFINum = Sheets(n).Range("E4") & " - "
  JobNum = Sheets(n).Range("B4") & " - "
  JobName = Sheets(n).Range("B5") & " - " & n
  Exten = ".pdf"
  '
  Sheets(n).ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="C:\Users\" & Environ("Username") & "\Downloads\" & RFIPrefix & RFINum & JobNum & JobName & Exten, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
End Sub

Sub Print_RFI_LOG_sub()
  Dim SheetName As String, JobNum As String, JobName As String, Exten As String
 
  SheetName = "RFI RECORD SHEET - "
  JobNum = Sheets(1).Range("D2") & " - "
  JobName = Sheets(1).Range("D3")
  Exten = ".pdf"
  '
  Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="C:\Users\" & Environ("Username") & "\Downloads\" & SheetName & JobNum & JobName & Exten, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
End Sub


--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------
 
Upvote 0
Hi Dante,

I've deleted out the sensitive information, see link to workbook below

The macro button I am using is the one that says do not use on the 1st sheet.


Hopefully that helps

Thanks
 
Upvote 0
Hello, there is nothing to check.
The macro works fine.
From sheet RFI4 onwards, cell E1 is empty in all sheets.

1683686283577.png


1683686335641.png


I checked the 100 sheets one by one and only the first three have "NO" in cell E1.

Check your sheets.
 
Upvote 0
Hi Dante, yip went back and checked. Apologies, user error :rolleyes:

It works :), much appreciated, thank you for your help!
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

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