Excel VBA to check if multiple worksheets exist

[Biz]

Dear All,

I am working to have excel VBA that checks if multiple worksheets exist before another macro is run. Problem is that this VBA can check 1 worksheet only. Is it possible to make mySheetName to check a range(A1:A80) from Sort Order worksheet tab?

Function SheetExists(i_SheetName As String, _
                     Optional i_WorkbookName As String) As Boolean
Dim myWorkbook As Workbook
 
  On Error Resume Next
  'set workbook that gets checked
  If i_WorkbookName = "" Then
    Set myWorkbook = ActiveWorkbook
  Else
    Set myWorkbook = Workbooks(i_WorkbookName)
    If myWorkbook Is Nothing Then Exit Function
  End If
  'now check if sheet exists
  SheetExists = Not myWorkbook.Sheets(i_SheetName) Is Nothing
End Function

Sub Test()
Dim myWorkbookName As String
Dim mySheetName As String
myWorkbookName = "Test.xls"
  'now check for the worksheet
  mySheetName = "Sheet4"
  If SheetExists(mySheetName, myWorkbookName) = True Then
    'sheet exists
    Debug.Print mySheetName & " in " & myWorkbookName & " exists."
  Else
    'sheet doesn't exist
    MsgBox mySheetName & " in " & myWorkbookName & " doesn't exist."
  End If
End Sub

Biz

[GTO]

Greetings Biz,

Between one of the adds killing my poor lame IE6 multiple times and it being a lazy Sunday, not utterly sure about these, but I think either should work.

I am presuming that if any sheet is missing, then you wouldn't want the code to continue. For a Boolean return, maybe:
[vba]
Sub Test2()
Dim myWorkbookName As String
Dim arySheetNames
Dim aryMySheetNames
Dim i As Long

'// For testing, change to suit //
myWorkbookName = ThisWorkbook.Name

'// Grab and transpose the range of sheet names on 'Sort Order' or whatever //
'// sheet name //
arySheetNames = Application.WorksheetFunction _
.Transpose(ThisWorkbook.Worksheets("Sheet1").Range("A1:A80").Value)

ReDim aryMySheetNames(1 To 1)

'// Some of the cells (A1:A80) may have been blank, so build an array of names //
'// only (skipping blanks). //
For i = LBound(arySheetNames) To UBound(arySheetNames)
If Not arySheetNames(i) = vbNullString Then
aryMySheetNames(UBound(aryMySheetNames)) = arySheetNames(i)
'// After adding a val to our new array, increase its size by one element //
'// for the next loop. //
ReDim Preserve aryMySheetNames(1 To (UBound(aryMySheetNames) + 1))
End If
Next

'// After done building our array of sheet names, we'll have one empty element //
'// left over from the last loop. Rid it. //
ReDim Preserve aryMySheetNames(1 To (UBound(aryMySheetNames) - 1))

'// Now for each sheetname in our "good" array, call the function. If any sheet //
'// does not exist, tell user and bail out. //
For i = LBound(aryMySheetNames) To UBound(aryMySheetNames)
If Not SheetExists2(aryMySheetNames(i), myWorkbookName) = True Then
MsgBox "Missing sheet", 0, ""
Exit Sub
End If
Next

'// No failures, then execute remaining code. //
MsgBox "Other code here"

End Sub

Function SheetExists2(ByVal i_SheetName As String, _
Optional i_WorkbookName As String) As Boolean
Dim myWorkbook As Workbook
Dim wksTemp As Worksheet
Dim i As Long

On Error Resume Next
'set workbook that gets checked
If i_WorkbookName = "" Then
Set myWorkbook = ActiveWorkbook
Else
Set myWorkbook = Workbooks(i_WorkbookName)
If myWorkbook Is Nothing Then Exit Function
End If

Set wksTemp = myWorkbook.Worksheets(i_SheetName)
If Not wksTemp Is Nothing Then SheetExists2 = True
End Function
[/vba]


Now I was thinking that you might want to know what sheet was missing if such a case arises. I think the below works, but I admit that this is the first time I recall trying to pass an array arg to the function...

[vba]
Sub Test()
Dim myWorkbookName As String
Dim aryShNames
Dim aryShNamesRange
Dim myReturn
Dim i As Long

myWorkbookName = ThisWorkbook.Name

'now check for the worksheet
aryShNamesRange = Application.WorksheetFunction _
.Transpose(ThisWorkbook.Worksheets("Sheet1").Range("A1:A80").Value)

ReDim aryShNames(1 To 1)

For i = LBound(aryShNamesRange) To UBound(aryShNamesRange)
If Not aryShNamesRange(i) = vbNullString Then
aryShNames(UBound(aryShNames)) = aryShNamesRange(i)
ReDim Preserve aryShNames(1 To (UBound(aryShNames) + 1))
End If
Next

ReDim Preserve aryShNames(1 To (UBound(aryShNames) - 1))

'// Call the function supplying an array of sheetnames (see function) //
myReturn = SheetExists(aryShNames, myWorkbookName)

If Not myReturn = "True" Then
MsgBox "Sheet: " & myReturn & " does not exist.", 0, ""
Exit Sub
Else
MsgBox "do stuff here", 0, ""
End If

End Sub

'// I believe this is the first time I've tried passing an array arg to a function, so //
'// ya may wish to stand a ways back and poke at F5 with a long twig... //
Function SheetExists(ByVal i_SheetName As Variant, _
Optional i_WorkbookName As String) As Variant
Dim myWorkbook As Workbook
Dim i As Long

On Error Resume Next
'set workbook that gets checked
If i_WorkbookName = "" Then
Set myWorkbook = ActiveWorkbook
Else
Set myWorkbook = Workbooks(i_WorkbookName)
If myWorkbook Is Nothing Then Exit Function
End If

'// Initially set to True //
SheetExists = True

'// For ea name in the array we passed, if the sheetname is not found, we return //
'// the string of which sheet was missing. Else, we return "True". //
For i = LBound(i_SheetName) To UBound(i_SheetName)
If myWorkbook.Sheets(i_SheetName(i)) Is Nothing Then
SheetExists = i_SheetName(i)
Exit For
End If
Next
End Function
[/vba]

Hope one of those work,

Mark

[rbrhodes]

Hi Biz,

Here's an example to get you started. I assume you are using a function in conjunction with the Sub because you need to use it elsewhere as well? (it could all be done in one piece of code).

Post back with questions.

[VBA]
Option Explicit
Function SheetExists(i_SheetName As String, Optional i_WorkbookName As String) As Boolean
Dim myWorkbook As Workbook

'//Probably better to handle errors
On Error GoTo endo

'set workbook that gets checked
If i_WorkbookName = "" Then
Set myWorkbook = ActiveWorkbook
Else
Set myWorkbook = Workbooks(i_WorkbookName)
If myWorkbook Is Nothing Then Exit Function
End If

'now check if sheet exists
SheetExists = Not myWorkbook.Sheets(i_SheetName) Is Nothing
endo:
'//Cleanup and exit
Set myWorkbook = Nothing
End Function
Sub Test()
Dim cel As Range
Dim rng As Range
Dim LastRow As Long
Dim mySheetName As String
Dim myWorkbookName As String
'//Could do multiples here too or put in Sub Arg
myWorkbookName = "Test.xls"

'//Get last row of data "Sort Order", Col A
LastRow = Sheets("Sort Order").Range("A65536").End(xlUp).Row
'//Set up where to look
Set rng = Sheets("Sort Order").Range("A1:A" & LastRow)

For Each cel In rng
'//Get cell value
mySheetName = cel
'now check for the worksheets
If SheetExists(mySheetName, myWorkbookName) = True Then
'sheet exists
Debug.Print mySheetName & " in " & myWorkbookName & " exists."
'//do something
Else
'sheet doesn't exist
MsgBox mySheetName & " in " & myWorkbookName & " doesn't exist."
'//do something else
End If
'//Check next
Next cel

'//Clean up and exit
Set cel = Nothing
Set rng = Nothing

End Sub

[/VBA]

Cheers,

dr

[Biz]

Hi Mark/rbrhodes,

Thank you both for your VBA codes. Mark second code does not loop and pick other worksheet names which are in error Test2().

Rbrhodes your code would like charm.

Guys I have question where can I learn more about Excel VBA or any particular course?

Biz

[GTO]

...Mark second code does not loop and pick other worksheet names which are in error Test2()...

Rbrhodes your code would like charm.

Guys I have question where can I learn more about Excel VBA or any particular course?

Hi Biz,

As Dr's sounds like the ticket, just to hopefully correct my previous...

[vba]
Option Explicit
Dim ShtNames_Missing

Sub Test()
Dim myWorkbookName As String
Dim aryShNames
Dim aryShNamesRange
Dim i As Long

myWorkbookName = ThisWorkbook.Name '"test.xls"

With ThisWorkbook.Worksheets("Sort Order")
aryShNamesRange = Application.WorksheetFunction _
.Transpose(.Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value)
End With

ReDim aryShNames(1 To 1)
For i = LBound(aryShNamesRange) To UBound(aryShNamesRange)
If Not aryShNamesRange(i) = vbNullString Then
aryShNames(UBound(aryShNames)) = aryShNamesRange(i)
ReDim Preserve aryShNames(1 To (UBound(aryShNames) + 1))
End If
Next
ReDim Preserve aryShNames(1 To (UBound(aryShNames) - 1))

If Not SheetExists(aryShNames, myWorkbookName) Then
MsgBox "Missing Sheets:" & ShtNames_Missing
ShtNames_Missing = vbNullString
Else
MsgBox "do stuff here"
End If
End Sub

Function SheetExists(ByVal i_SheetName As Variant, _
Optional i_WorkbookName As String) As Boolean
Dim myWorkbook As Workbook
Dim i As Long
On Error Resume Next
If i_WorkbookName = "" Then
Set myWorkbook = ActiveWorkbook
Else
Set myWorkbook = Workbooks(i_WorkbookName)
If myWorkbook Is Nothing Then Exit Function
End If

SheetExists = True

For i = LBound(i_SheetName) To UBound(i_SheetName)
If myWorkbook.Sheets(i_SheetName(i)) Is Nothing Then
ShtNames_Missing = ShtNames_Missing & vbCrLf & i_SheetName(i)
SheetExists = False
End If
Next
On Error GoTo 0
End Function
[/vba]

I don't really have any suggestions as to books/courses. What I have been able to pick up is mostly through here, as well as a buddy who is awfully bright and of course searching the web. I find vbaexpress, or that is the folks here, just super helpful.

Have a great day

Mark

[Aussiebear]

Hi Biz, NO harm in undertaking the training here at VBA Express, just go to the main portal and select the training option.

[Biz]

Thanks mark for your help.

Hi Biz,

As Dr's sounds like the ticket, just to hopefully correct my previous...

[vba]
Option Explicit
Dim ShtNames_Missing

Sub Test()
Dim myWorkbookName As String
Dim aryShNames
Dim aryShNamesRange
Dim i As Long

myWorkbookName = ThisWorkbook.Name '"test.xls"

With ThisWorkbook.Worksheets("Sort Order")
aryShNamesRange = Application.WorksheetFunction _
.Transpose(.Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value)
End With

ReDim aryShNames(1 To 1)
For i = LBound(aryShNamesRange) To UBound(aryShNamesRange)
If Not aryShNamesRange(i) = vbNullString Then
aryShNames(UBound(aryShNames)) = aryShNamesRange(i)
ReDim Preserve aryShNames(1 To (UBound(aryShNames) + 1))
End If
Next
ReDim Preserve aryShNames(1 To (UBound(aryShNames) - 1))

If Not SheetExists(aryShNames, myWorkbookName) Then
MsgBox "Missing Sheets:" & ShtNames_Missing
ShtNames_Missing = vbNullString
Else
MsgBox "do stuff here"
End If
End Sub

Function SheetExists(ByVal i_SheetName As Variant, _
Optional i_WorkbookName As String) As Boolean
Dim myWorkbook As Workbook
Dim i As Long
On Error Resume Next
If i_WorkbookName = "" Then
Set myWorkbook = ActiveWorkbook
Else
Set myWorkbook = Workbooks(i_WorkbookName)
If myWorkbook Is Nothing Then Exit Function
End If

SheetExists = True

For i = LBound(i_SheetName) To UBound(i_SheetName)
If myWorkbook.Sheets(i_SheetName(i)) Is Nothing Then
ShtNames_Missing = ShtNames_Missing & vbCrLf & i_SheetName(i)
SheetExists = False
End If
Next
On Error GoTo 0
End Function
[/vba]

I don't really have any suggestions as to books/courses. What I have been able to pick up is mostly through here, as well as a buddy who is awfully bright and of course searching the web. I find vbaexpress, or that is the folks here, just super helpful.

Have a great day

Mark