For Each Sheet loop -- skip a sheet if row2 is empty

[supper's ready]

i've got a loop that goes through each sheet and does some things

how do i get the loop to skip a sheet (go to the next one) if row 2 is blank on the sheet.

 

[VoG]

Try like this

Sub b()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
        If WorksheetFunction.CountA(.Rows(2)) > 0 Then
        '
        'do something
        '
    End With
Next ws
End Sub

 

[supper's ready]

Sub CreateWorkbooks()

Dim Source As Workbook 'The excel file with all the tabs to be exported
Set Source = ActiveWorkbook 'sets the source to the excel file that is active

Dim Sheet As Object 'the tab/sheet to be exported

Dim strSavePath As String 'the directory where the tab should be exported to

Dim Destination As Workbook 'The excel file that results when export of tab is complete

For Each Sheet In Source.Sheets 'says for every sheet in the Source, do this
    With Sheet
        If WorksheetFunction.CountA(.Rows(2)) > 0 Then

Dim iYearFolder As Integer 'Initial year value (guess)
Dim iMonthFolder As Integer 'Initial month value (guess)
Dim fYearFolder As Variant 'Final year value (set by user)
Dim fMonthFolder As Variant 'Final month value (set by user)

iYearFolder = 0 'initialize to zero
iMonthFolder = 0 'initialize to zero

    'Begin date finding
    'The below code will find the dates to be set as default values in the input boxes. These are guesses to making things easier for the user
    Dim SlashFound As Range
    Dim FirstSlashFound As String
    
    Set SlashFound = Sheet.Cells.Find("/", , xlFormulas, xlPart) 'look for a /
    
    If Not SlashFound Is Nothing Then 'if a / is found then
        If Not IsDate(SlashFound) Then 'test if its a date, if its not then
            FirstSlashFound = SlashFound.Address 'set FirstSlashFound = to the address of the first / found
            Do
                Set SlashFound = Sheet.Cells.FindNext(SlashFound) 'go to the next / value
            Loop Until IsDate(SlashFound) Or SlashFound.Address = FirstSlashFound 'keep doing it until the / value is a date or you get back to the original / found (means you looked everywhere)
        End If
    End If
    
    If IsDate(SlashFound) Then 'now that we've looked everywhere, if we got a date we can assign values
        iYearFolder = Year(SlashFound)
        iMonthFolder = Month(SlashFound)
    Else
        MsgBox "No date found on worksheet" 'otherwise we say we couldn't find a date
    End If
    'End date finding
    
Dim ymessage, ytitle As String
Dim mmessage, mtitle As String

ymessage = "Enter the Year for the data (Enter to accept)"
mmessage = "Enter the Month for the data (Enter to accept)"

ytitle = "Year Input Box for " & Sheet.Name
mtitle = "Month Input Box " & Sheet.Name

fYearFolder = InputBox(ymessage, ytitle, iYearFolder)
fMonthFolder = InputBox(mmessage, mtitle, iMonthFolder)

If Len(Dir("C:\Export Test\" & Sheet.Name, vbDirectory)) = 0 Then
MkDir "C:\Export Test\" & Sheet.Name
Else
If Len(Dir("C:\Export Test\" & Sheet.Name & "\" & fYearFolder, vbDirectory)) = 0 Then
MkDir "C:\Export Test\" & Sheet.Name & "\" & fYearFolder
MkDir "C:\Export Test\" & Sheet.Name & "\" & fYearFolder & "\" & fMonthFolder
Else
If Len(Dir("C:\Export Test\" & Sheet.Name & "\" & fYearFolder & "\" & fMonthFolder, vbDirectory)) = 0 Then
MkDir "C:\Export Test\" & Sheet.Name & "\" & fYearFolder & "\" & fMonthFolder
End If
End If
End If

strSavePath = "C:\Export Test\" & Sheet.Name & "\" & fYearFolder & "\" & fMonthFolder & "\"

Sheet.Copy

Set Destination = ActiveWorkbook

Dim filename As Variant
Dim fmessage, ftitle As String
Dim ifilename As Integer
ifilename = Day(SlashFound)
fmessage = "Enter the range of dates (e.g. 1-31) for the data."
ftitle = "File Name Prompt for " & Sheet.Name
filename = InputBox(fmessage, ftitle, ifilename)

Destination.SaveAs strSavePath & filename
Destination.Close

End With

Next

Exit Sub

End Sub

says End With without With, what gives?

 

[VoG]

Sorry, I missed out an End If

Sub b()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    With ws
        If WorksheetFunction.CountA(.Rows(2)) > 0 Then
        '
        'do something
        '
        End If
    End With
Next ws
End Sub

 

[supper's ready]

you da man