Excel VBA to check if multiple worksheets exist

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?

Code:

---

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

---

Code:

---

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

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

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

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:beerchug:

Quote:

---

Originally Posted by Biz

...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 :thumb

Mark

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

Thanks mark for your help.

Quote:

---

Originally Posted by GTO

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 :thumb

Mark

---