VBA Search for sheet in .xls but if not found then go to next

8

8Dozer8

New Member
Joined
Sep 27, 2019
Messages
3
Ok, So I've done my best to try and figure this out for myself but I havent gotten anywhere. Ive even searched around on here to find a thread with a similar problem that I have and havent quite found what I was looking for, ... though I did find better ways to do other things that I didnt know I could do more efficiently.

I have a VBA code that set to search though a folder where all the .xls files get saved for the company I work for. I thought all the .xls files were the same so I set up the code to just pull data out and paste it on a different page. In each of the .xls files that I want to pull data from the Sheet is named "Insulation" but there are other .xls files that dont have a sheet named Insulation so when the program gets to one of these files then it stops running and throws up an error.

To combat this I thought this would work but I'm guessing that I'm assuming that the program knows what I'm refering to and I'm not really conveying what I think I am:

SheetName = "Insulation" If SheetName = vbNullString Then
GoTo Skip2This

End If

If posting more of my code will help, I'll do that but I figure that this is the only part I'm really struggling with... and I figure less is more... because if I were to post all 200 or so lines then you might be wondering where the part is that I need help on... or maybe thats just me, I don't know.

Thanks in advance though.:)
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
You could use a function like
Rich (BB code): 
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

and call it from your existing code, this will return a true or false value depending on whether the sheet exists
 
Last edited:
Upvote 0
Rich (BB code): 
   If Evaluate("ISREF('Insulation'!A1)") Then 'Test if worksheet name exists
        'Sheet exists
    Else
        'Sheet doesn't exist
    End If
 
Last edited:
Upvote 0
Sorry for my ignorance, I couldnt get either one to work yesterday. I am still a beginner in the realm of code so maybe I did something wrong. I've commented out things that I've tried in the past too so maybe you can see where I've came from so I'm just going to post my whole code... dont know if that will help or hinder or matter. I did look up some of the command prompts that you guys used to try and better understand it but it didnt help me to understand how to fix it.

Code: 
Sub RequestData()    Application.ScreenUpdating = False
        '>>> turning to false speeds things up
    Application.Calculation = xlCalculationManual 'might also speed things up
    Application.EnableEvents = False 'also might speed things up
    
    
    '>>> DEFINITION & CONSTANTS
    Dim SheetD As String, SheetM As String, SheetName As String
    Dim RowD As Double, NewEntry As Integer
    Dim ActiveB As String, ExcelF As String, FldrPath As String
    Dim rng As Range, eFilePath As String, DateTime As Date
    Dim EarlyDate As Date, Ddate As Date, FullPath As String
    Dim LateDate As Date
    
    SheetD = "DATA"
    SheetM = "DASHBOARD"
    NewEntry = 0
        'Keeps track and reports at the end how many files were added (just for FYI)
    ActiveB = ActiveWorkbook.Name
    RowD = 2
    FldrPath = Sheets(SheetM).Cells(2, 3).Value
    
    '>>> FIND NEXT OPEN ROW
    Do Until IsEmpty(Sheets(SheetD).Cells(RowD, 1))
        RowD = RowD + 1
    Loop
    
    '>>> SCAN FOLDER & OPEN/COPY NEW ENTRIES
    ExcelF = Dir(FldrPath & "\*.xls")
     
     Do Until ExcelF = ""
    
        Workbooks(ActiveB).Sheets(SheetM).Cells(10, 3).Value = ExcelF
        eFilePath = Cells(10, 3)
        FullPath = FldrPath & "\" & eFilePath
        DateTime = FileDateTime(FullPath)
        EarlyDate = Sheets(SheetM).Cells(3, 3)
        LateDate = Sheets(SheetM).Cells(3, 4)
        
        If DateTime > EarlyDate And DateTime < LateDate Then
            
             'If eFilePath = "* PVT EXCITATION.xls" Then
              'GoTo Skip2This
             
             'ElseIf eFilePath = "*_regulation.xls" Then
            ' GoTo Skip2This
             
             'ElseIf eFilePath = "228348.10.I05 123 HQ AFTER *.xls" Then
             'GoTo Skip2This
             
            '>>OPEN FILE
            'Else
            Workbooks.Open (FullPath)
             'End If
            
            '>>SET VALUES EQUAL TO DATA ROW
        SheetName = "Insulation"
   ' If Evaluate("ISREF('Insulation'!A1)") Then 'Test if worksheet name exists
        'Sheet exists
    '    GoTo Continue
   ' Else
        'Sheet doesn't exist
     '   GoTo Skip2This
    'End If
        
    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 = (Wbk.Sheets(ShtName).Name) = (ShtName)
    On Error GoTo Skip2This
End Function


Continue:
    Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:H5").Find("Project:", LookIn:=xlValues)
            Workbooks(ActiveB).Activate
            Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 1).Value = rng.Offset(0, 2).Value
        ' On Error GoTo Skip2This
                '>>Get Project#
                
    Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:H5").Find("S/N:", LookIn:=xlValues)
            Workbooks(ActiveB).Activate
            Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 2).Value = rng.Offset(0, 2).Value
         '   On Error GoTo Skip2This
                '>>Get Serial#
                
    Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:H5").Find("Type:", LookIn:=xlValues)
            Workbooks(ActiveB).Activate
            Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 3).Value = rng.Offset(0, 2).Value
          '  On Error GoTo Skip2This
                '>>Get Unit Type
                                       
    Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A30:C60").Find("Measured capacitance", LookIn:=xlValues)
            Workbooks(ActiveB).Activate
            Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 4).Value = rng.Offset(0, 4).Value
           ' On Error GoTo Skip2This
                '>>Get 2nd Capacitance measurement at 100% measurement voltage
                       
   Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A30:C60").Find("Dissipation factor:", LookIn:=xlValues)
            Workbooks(ActiveB).Activate
            Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 5).Value = rng.Offset(0, 4).Value
            ' On Error GoTo Skip2This
                '>>Get 2nd DF value at 100% measurement voltage
                
    Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:C90").Find("Date tested", LookIn:=xlValues)
            Workbooks(ActiveB).Activate
            Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 6).Value = rng.Offset(0, 2).Value
            'On Error GoTo Skip2This
                   '>>Get Date Tested
        
        
    NewEntry = NewEntry + 1
          RowD = RowD + 1
            '>>CLOSE FILE
Skip2This:
            Workbooks(ActiveB).Activate
            Workbooks(ExcelF).Close SaveChanges:=False
        End If
        
     
        ExcelF = Dir()
   
    Loop
    
    '>>> FINAL OPERATIONS
    'Sheets(SheetM).Cells(3, 3).Value = Now
    'Application.StatusBar = "Updated Data (" & NewEntry & "): " & Now
    Cells(10, 3) = ""
    If NewEntry > 0 Then
    Sheets(SheetD).Activate
    End If
    MsgBox "There were " & NewEntry & " reports that matched your query."
    Application.ScreenUpdating = True
    Application.ScreenUpdating = xlCalculationAutomatic
    Application.EnableEvents = True
    
End Function
 
Upvote 0
The function needs to go outside the sub like
Rich (BB code): 
Option Explicit

Sub RequestData()
   Application.ScreenUpdating = False
        '>>> turning to false speeds things up
    Application.Calculation = xlCalculationManual 'might also speed things up
    Application.EnableEvents = False 'also might speed things up
    
    
    '>>> DEFINITION & CONSTANTS
    Dim SheetD As String, SheetM As String, SheetName As String
    Dim RowD As Double, NewEntry As Integer
    Dim ActiveB As String, ExcelF As String, FldrPath As String
    Dim rng As Range, eFilePath As String, DateTime As Date
    Dim EarlyDate As Date, Ddate As Date, FullPath As String
    Dim LateDate As Date
    
    SheetD = "DATA"
    SheetM = "DASHBOARD"
    NewEntry = 0
        'Keeps track and reports at the end how many files were added (just for FYI)
    ActiveB = ActiveWorkbook.Name
    RowD = 2
    FldrPath = Sheets(SheetM).Cells(2, 3).Value
    
    '>>> FIND NEXT OPEN ROW
    Do Until IsEmpty(Sheets(SheetD).Cells(RowD, 1))
        RowD = RowD + 1
    Loop
    
    '>>> SCAN FOLDER & OPEN/COPY NEW ENTRIES
    ExcelF = Dir(FldrPath & "\*.xls")
     
     Do Until ExcelF = ""
    
        Workbooks(ActiveB).Sheets(SheetM).Cells(10, 3).Value = ExcelF
        eFilePath = Cells(10, 3)
        FullPath = FldrPath & "\" & eFilePath
        DateTime = FileDateTime(FullPath)
        EarlyDate = Sheets(SheetM).Cells(3, 3)
        LateDate = Sheets(SheetM).Cells(3, 4)
        
        If DateTime > EarlyDate And DateTime < LateDate Then
            
             'If eFilePath = "* PVT EXCITATION.xls" Then
              'GoTo Skip2This
             
             'ElseIf eFilePath = "*_regulation.xls" Then
            ' GoTo Skip2This
             
             'ElseIf eFilePath = "228348.10.I05 123 HQ AFTER *.xls" Then
             'GoTo Skip2This
             
            '>>OPEN FILE
            'Else
            Workbooks.Open (FullPath)
             'End If
            
            '>>SET VALUES EQUAL TO DATA ROW
    If ShtExists("Insulation") Then
       Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:H5").Find("Project:", LookIn:=xlValues)
               Workbooks(ActiveB).Activate
               Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 1).Value = rng.Offset(0, 2).Value
           ' On Error GoTo Skip2This
                   '>>Get Project#
                   
       Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:H5").Find("S/N:", LookIn:=xlValues)
               Workbooks(ActiveB).Activate
               Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 2).Value = rng.Offset(0, 2).Value
            '   On Error GoTo Skip2This
                   '>>Get Serial#
                   
       Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:H5").Find("Type:", LookIn:=xlValues)
               Workbooks(ActiveB).Activate
               Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 3).Value = rng.Offset(0, 2).Value
             '  On Error GoTo Skip2This
                   '>>Get Unit Type
                                          
       Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A30:C60").Find("Measured capacitance", LookIn:=xlValues)
               Workbooks(ActiveB).Activate
               Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 4).Value = rng.Offset(0, 4).Value
              ' On Error GoTo Skip2This
                   '>>Get 2nd Capacitance measurement at 100% measurement voltage
                          
      Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A30:C60").Find("Dissipation factor:", LookIn:=xlValues)
               Workbooks(ActiveB).Activate
               Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 5).Value = rng.Offset(0, 4).Value
               ' On Error GoTo Skip2This
                   '>>Get 2nd DF value at 100% measurement voltage
                   
       Set rng = Workbooks(ExcelF).Sheets("Insulation").Range("A1:C90").Find("Date tested", LookIn:=xlValues)
               Workbooks(ActiveB).Activate
               Workbooks(ActiveB).Sheets(SheetD).Cells(RowD, 6).Value = rng.Offset(0, 2).Value
               'On Error GoTo Skip2This
                      '>>Get Date Tested
           
           
       NewEntry = NewEntry + 1
             RowD = RowD + 1
   End If
            '>>CLOSE FILE
Skip2This:
            Workbooks(ActiveB).Activate
            Workbooks(ExcelF).Close SaveChanges:=False
        End If
        
     
        ExcelF = Dir()
   
    Loop
    
    '>>> FINAL OPERATIONS
    'Sheets(SheetM).Cells(3, 3).Value = Now
    'Application.StatusBar = "Updated Data (" & NewEntry & "): " & Now
    Cells(10, 3) = ""
    If NewEntry > 0 Then
    Sheets(SheetD).Activate
    End If
    MsgBox "There were " & NewEntry & " reports that matched your query."
    Application.ScreenUpdating = True
    Application.ScreenUpdating = xlCalculationAutomatic
    Application.EnableEvents = True
    
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 = (Wbk.Sheets(ShtName).Name) = (ShtName)
    On Error GoTo 0
End Function
 
Last edited:
Upvote 0
Ok thanks Fluff, that worked.

If you have time, could you explain to me how this works... if not that's cool. I'll eventually figure it out.
 
Upvote 0
If the sheet exists in the workbook this
Code: 
Wbk.Sheets(ShtName).Name
will return the name of the sheet, otherwise it will return an error.
Then if the sheet does exist this
Code: 
(Wbk.Sheets(ShtName).Name) = (ShtName)
"Insulation"="Insulation" which returns TRUE, if the sheet doesn't exists it returns FALSE

HTH
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
124
sijpie
sijpie
D
  • Question Question
Help with sorting through order data
Replies
5
Views
276
Fuji
F
J
  • Question Question
Search folder for value and list left/right value
Replies
2
Views
212
JJCam
J
B
  • Question Question
Using VBA and Acrobat Add-in to export sheet as PDF
Replies
2
Views
281
Basher515
B
L
  • Question Question
VBA - Search all folders for datal/text
Replies
4
Views
665
MikeVol
MikeVol

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top