Loping through each worksheet with an exception

[KathCobb]

Hello. My name is Kathy and this is my first post here. :) I have very basic knowledge of Excel VBA and with the help of the internet I've been able to automate several tasks...and I am sure that all my code is exceptionally more complicated than it ever has to be but I just cobbled it together and it works so I do the best that I can. With that said, I can NOT get a current task to work. I thought I had it once but alas, it does not work.

What I need: I simply want to loop through every sheet in my workbook and save it as a PDF. But I want to skip any worksheets that the Cell A2 is empty. I tried this:







Sub LoopSheetsSaveAsPDF2()


'Create variables
Dim ws As Worksheet


'Loop through all worksheets and save as individual PDF in same folder
'as the Excel file
For Each ws In ActiveWorkbook.Worksheets


If Range("A2").Value = "" Then
GoTo start_Here
Else
GoTo not_blank
End If


not_blank:


ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\Kathy\Documents\ToSend\" & ws.Name & ".pdf", _
IgnorePrintAreas:=False

start_Here:
Next


End Sub




The worksheets do save to PDF but it does not skip the sheets that Cell A2 is blank. This was the best idea I had.... I know using GoTo is really not first choice but I am terrible at loops and variables.

I would greatly appreciate it if someone could tell me what is wrong with what I have here and explain the correct way to do what I am trying to do.

Many thanks in advance,
Kathy

[Paul_Hossler]

Couple of things I noticed with ...



If Range("A2").Value = "" Then


1. A2 may look empty but if there's a space of something else, then it's not

2. Most probably it's because 'Range' without a worksheet will default to what ever the Activesheet is, which probably will not be the one you want (i.e. ws.)

Try



If ws.Range("A2").Value = "" Then




You didn't ask, but I think you can simplify the code a little



Option Explicit


Sub LoopSheetsSaveAsPDF2()
'Create variables
Dim ws As Worksheet


'Loop through all worksheets and save as individual PDF in same folder
'as the Excel file
For Each ws In ActiveWorkbook.Worksheets
If Len(ws.Range("A2").Value) > 0 Then
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\Kathy\Documents\ToSend\" & ws.Name & ".pdf", _
IgnorePrintAreas:=False
End If
Next
End Sub

[KathCobb]

I had tried the ws.Range before I posted and it still did not work. I really appreciate the suggestion of a more simplified method. I gave it a try and it WORKED PERFECTLY. Thank you so much.:bow:

Would it be possible to add a few other things for the code to do in each A2 is not black worksheet? I would be a huge help if I could have it WrapText in each worksheet Columns B and D. Also if Column E could be formatted as "accounting" or Dollars that would be fantastic. I have tried many different methods to get the text to wrap but when I go to check the worksheet, Wrap Text is selected but the text doesnt actually wrap.....so I must be doing something wrong. Thanks in advance for any additional help :)

[Paul_Hossler]

The macro recorder does a good job of capturing your actions and translating them into Excel-speak. It captures EVERYTHING so the trick is cleaning it up.

Macro3 is from the recorder and you can see all (EVERY) thing. Macro CleanedUp is just the stuff we need, generalized and simplified

BTW, I like to use column numbers (personal preference)



Option Explicit

Sub Macro3()
'
' Macro3 Macro
'


'
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("D:D").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").Select
Selection.NumberFormat = "$#,##0.00"
End Sub




Sub CleanedUp()
With ws.Columns(2)
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
End With
With ws.Columns(4)
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
End With

ws.Columns(5).NumberFormat = "$#,##0.00"
End Sub





Personal preference: Using With/End With on an object (like 'ws' or '.Columns(4)' ) can eliminate a lot of 'code clutter' where The.Same.Object is used on lots of lines. You don't need if you don't want



The.Same.Object.Interior.Color=vbRed
The.Same.Object.Font.Bold = True
The.Same.Object.Font.Italic = False
The.Same.Object.Borders.Weight = xlThin




This would make your macro something like this (UNTESTED)



Option Explicit




Sub LoopSheetsSaveAsPDF2()
Dim ws As Worksheet
Dim sPath As String


'save path of this workbook to use with PDFs
'e.g. "C:\Users\Kathy\Documents\ToSend" & "\"
sPath = ThisWorkbook.Path & Application.PathSeparator


'Loop through all worksheets and save as individual PDF in same folder as the Excel file
For Each ws In ActiveWorkbook.Worksheets
With ws
If Len(.Range("A2").Value) > 0 Then
With .Columns(2)
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
End With
With .Columns(4)
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
End With

With .Columns(5)
.NumberFormat = "$#,##0.00"
.VerticalAlignment = xlTop
End With

.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & ws.Name & ".pdf", IgnorePrintAreas:=False
End If
End With
Next
End Sub

[KathCobb]

This is fantastic...I cannot wait to try it. Thank you so much!
I do use the Macro recorder but I do not know how to clean up a lot of the stuff that is shown, so Leave it. I did not know I could eliminate stuff like what I pasted below. I keep everything because I just do not know what is needed. I need to look your example over in depth so I can get a good idea of what is repeated/not needed.

.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False


What I would like to do is incorporate the code "When Cell A2 is blank" (or an equivalent) go to the next thing. I have a super long code that Autofilters and then copies the visible cells to a new worksheet which it then names and formats. Then I start it over for the next Autofilter criteria. Below is that start of the code that basically is to create the new worksheet and copy it then start the formatting (removed a lot of the formatting to save space). How would I be able to say if when autofiltered, only the header row is there, so do not create a new worksheet, do not do any formatting because there is not a new worksheet and move to the next autofilter? The auto filter and all the sheet formatting is repeated 15 times. That is one of my biggest issues...I don't know WHERE to put things to bring it all together. Even I knew how (and I don't :() to say if only data is in the header row skip new worksheet, I wouldn't know how to have the code then start at the next auto filter. That is why I tried using "GoTo" and I still couldn't figure it out in this code.


My_Range.AutoFilter Field:=1, Criteria1:="331768"


'Add a new Worksheet
Set WSNew = Worksheets.Add(After:=Worksheets("New Only"))


On Error Resume Next

'Name the New Worksheet automatically
WSNew.Name = "MarkC"
If Err.Number > 0 Then
MsgBox "Change the name of sheet : " & WSNew.Name & _
" manually after the macro is ready. The sheet name" & _
" you fill in already exists or you use characters" & _
" that are not allowed in a sheet name."
Err.Clear
End If

On Error GoTo 0

'Copy/paste the visible data to the new worksheet

My_Range.Parent.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the column width in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
ActiveCell.Rows("1:1").EntireRow.Select
ActiveCell.Activate
End With

My_Range.Parent.AutoFilterMode = False
'Restore ScreenUpdating, Calculation, EnableEvents, ....
My_Range.Parent.Select
ActiveWindow.View = ViewMode
If Not WSNew Is Nothing Then WSNew.Select
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic

End With

Worksheets("MySheet").Activate

' Set New Filter Criteria

[Paul_Hossler]

Make it modular with 'lower level' subs that perform specific functions to things that are passed

So this sub gets a worksheet object, the Col A filter value, and the name of the sheet to contain just the filtered data from the InputSheet



Private Sub MakeNewSheet(InputSheet As Worksheet, Column1Critera As String, NewSheetName As String)


This way the same piece of code is a little smarter and can process each sheet in the WB (the 'ws' paramters), the filter value (the 'A', 'B', ...) and the name of the output worksheet



Call MakeNewSheet(ws, "A", "Arron")
Call MakeNewSheet(ws, "B", "Bill")
Call MakeNewSheet(ws, "C", "Charles")
Call MakeNewSheet(ws, "X", "Nope")





I did not understand a lot of what you wanted to do, but this might get you started

It does handle the case where there are no matching rows




Option Explicit


Sub LoopSheetsSaveAsPDF3()
Dim ws As Worksheet
Dim sPath As String




'save path of this workbook to use with PDFs
'e.g. "C:\Users\Kathy\Documents\ToSend" & "\"
sPath = ActiveWorkbook.Path & Application.PathSeparator




'Loop through all worksheets and save as individual PDF in same folder as the Excel file
For Each ws In ActiveWorkbook.Worksheets
If Len(ws.Range("A2").Value) > 0 Then

ws.Tab.Color = vbGreen

If ws.FilterMode Then ws.Cells(1, 1).AutoFilter

Call FormatExistingSheet(ws)

Call MakeNewSheet(ws, "A", "Arron")
Call MakeNewSheet(ws, "B", "Bill")
Call MakeNewSheet(ws, "C", "Charles")
Call MakeNewSheet(ws, "X", "Nope")

' ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & ws.Name & ".pdf", IgnorePrintAreas:=False

ws.Cells(1, 1).AutoFilter

Else
ws.Tab.Color = vbRed

End If
Next

MsgBox "Done"


End Sub




Private Sub FormatExistingSheet(wsExisting As Worksheet)
With wsExisting
.Columns.HorizontalAlignment = xlGeneral
.Columns.VerticalAlignment = xlTop

.Columns(2).WrapText = True
.Columns(4).WrapText = True
.Columns(5).NumberFormat = "$#,##0.00"
End With
End Sub


Private Sub MakeNewSheet(InputSheet As Worksheet, Column1Critera As String, NewSheetName As String)
Dim sSheetName As String
Dim wsNew As Worksheet
Dim rVisible As Range

'make name for filtered sheet
sSheetName = InputSheet.Name & "-" & NewSheetName


'delete if it exists
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(sSheetName).Delete
Application.DisplayAlerts = True
On Error GoTo 0


'filter input sheet
InputSheet.Cells(1, 1).CurrentRegion.AutoFilter Field:=1, Criteria1:=Column1Critera

Set rVisible = InputSheet.Cells(1, 1).CurrentRegion.SpecialCells(xlCellTypeVisible)

'only header row visible so exit
If rVisible.Areas.Count = 1 Then
If rVisible.Rows.Count = 1 Then
Exit Sub
End If
End If

'add new worksheet
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wsNew = ActiveSheet
wsNew.Name = sSheetName
wsNew.Tab.Color = vbBlue

'copy and paste filtered list to new sheet
rVisible.Copy
With Worksheets(sSheetName).Range("A1")
' Paste:=8 will copy the column width in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With


Application.CutCopyMode = False

End Sub

[KathCobb]

I am sorry that I was not clear. The code for auto filtering is a completely different code than the one for saving as PDF. If I use your sample for there not being any data other than the header row, it would exit the entire sub. I have 15 different filtering criteria that I go through... The steps are: Filter, copy to new worksheet, format new worksheet, go back to Original Worksheet, filter for a new criteria, copy that to its own sheet, etc. I am sure there is a way to set it up as a loop but I do not know how.

[Paul_Hossler]

If I use your sample for there not being any data other than the header row, it would exit the entire sub.

If you're talking about this, yes it exits the sub, but the sub it exits is MakeNewSheet() so it goes back to the next line in NewRequest()



'only header row visible so exit
If rVisible.Areas.Count = 1 Then
If rVisible.Rows.Count = 1 Then
Exit Sub
End If
End If



I just used this to do a little formatting on the output sheet. You can make it what you want



'format output sheet
With Worksheets(NewSheetName)
For i = 2 To .Rows.Count
Select Case .Cells(i, 3).Value
Case 100
.Cells(i, 3).Interior.Color = vbRed
Case 200
.Cells(i, 3).Interior.Color = vbGreen
Case 300
.Cells(i, 3).Interior.Color = vbYellow
End Select
Next i
End With


BTW, since this doesn't seem to have anything to do with the write PDF files question, it would probbly be clearer to start a new thread and not just tack on to one that has nothing to do with the new one

[KathCobb]

Yes, I thought of that about starting a new thread. I will do that because this is completely different and I think need it to continue through without a new sub.... I dont want to break protocol, so if I start a new thread, do I need to link to this one?

[KathCobb]

I dont know why I am doing wrong with new post. I received the error message below. My post does not contain any URL's or forbidden words that I am aware of....

[Paul_Hossler]

1. No need to start a new thread this time -- I understand that it's a different issue. No need to link unless you feel some context would help the second thread

2. No message in your next post #10. Sometimes the BB gets a little persnickity, but usually the [+Post New Thread] button is all that you need to do

[KathCobb]

Something must be wrong withy copy and paste...everytime I try and post my code example it says that it is denied due to URLs or Forbidden words. I have neither. It is the same code Posted above but it repeats. I tried to post it here as a reply and same message.

[Paul_Hossler]

Paste it into Notepad and then try to attach the TXT