VBA Check Sheets Names

[MikoSDS]

Hello Everyone,

I have question about checking specific sheets names in opened workbook before copying them to the correct workbook and if one of them does not exist then exit sub.

Currently I have this code:

Sub test()


Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim workbookpath As String


MsgBox "Please choose the file.'", vbInformation, "Information"


Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
Application.FileDialog(msoFileDialogOpen).Show
workbookpath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)


Cells(1, 1) = workbookpath


Set Wb1 = ActiveWorkbook
Set Wb2 = Workbooks.Open(workbookpath)


Wb2.Sheets("a").Copy after:=Wb1.Sheets("Start")
Wb2.Sheets("b").Copy after:=Wb1.Sheets("Start")
Wb2.Sheets("c").Copy after:=Wb1.Sheets("Start")
Wb2.Sheets("d").Copy after:=Wb1.Sheets("Start")
Wb2.Sheets("e").Copy after:=Wb1.Sheets("Start")
Wb2.Sheets("f").Copy after:=Wb1.Sheets("Start")
Wb2.Sheets("g").Copy after:=Wb1.Sheets("Start")


Wb2.Close


End Sub

 

[Fluff]

If one sheet does not exist do you still want to copy the other sheets?

 

[MikoSDS]

No, it should abort the code completely and prompt with msgbox with the missing/not valid worksheet

 

[Fluff]

Ok, how about

Sub MikoSDS()
    Dim Ary As Variant
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim Fname As String, Msg As String
    Dim i As Long
    
    Set Wb1 = ActiveWorkbook
    Ary = Array("a", "b", "c", "d", "e", "f", "g")
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        If .Show = -1 Then Fname = .SelectedItems(1)
    End With
    If Fname = "" Then Exit Sub
    Set Wb2 = Workbooks.Open(Fname)
    For i = 0 To UBound(Ary)
        If Not ShtExists(CStr(Ary(i)), Wb2) Then Msg = Msg & Ary(i) & vbLf
    Next i
    If Msg <> "" Then
        MsgBox "These sheet(s) are missing" & vbLf & Msg
        Exit Sub
    End If
    Wb2.Sheets("a").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("b").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("c").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("d").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("e").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("f").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("g").Copy after:=Wb1.Sheets("Start")
    
    Wb2.Close
End Sub



Public Function ShtExists(ShtName As String, Optional Wbk As Workbook) As Boolean
    If Wbk Is Nothing Then Set Wbk = ActiveWorkbook
    On Error Resume Next
    ShtExists = (LCase(Wbk.Sheets(ShtName).Name) = LCase(ShtName))
    On Error GoTo 0
End Function

 

[mikerickson]

Perhaps

Sub test()
'.....

[COLOR="#FF0000"]On Error Goto NoSheet[/COLOR]

    Wb2.Sheets("a").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("b").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("c").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("d").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("e").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("f").Copy after:=Wb1.Sheets("Start")
    Wb2.Sheets("g").Copy after:=Wb1.Sheets("Start")


    Wb2.Close
[COLOR="#FF0000"]Exit Sub
NoSheet:

    MsgBox "oops"
    On Error Goto 0[/COLOR]
End Sub

 

[MikoSDS]

@Fluff, that is perfect! I was looking exactly for this

 

[Fluff]

You're welcome & thanks for the feedback