VBA to check if worksheet exist before uploading from source workbook & if exist upload and display source workbook name.

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
Dear VBA Masters.
I tried to modified code I am using for uploading specific worksheet from another workbook from any location. So far all was quite easy and seems to work fine. It works fine when correct file is being picked. If user will pick workbook that does not contain specific sheet Debug window pops up. I would likeVBA to check first if source workbook contains specific worksheet and then carry on with code, else to call Import_Requirements again. Also if worksheet will be uploaded into target workbook i need to display name of source book in worksheet "Real Time Status" in range "E1"
All my efforts with "If else" failed and just gave up :(
VBA Code:
Public Sub Import_Requirements()

    Application.ScreenUpdating = False
    
   'Get workbook...
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Application.ThisWorkbook

    ' get the customer workbook
    Dim Filter As String
    Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"

    Dim Caption As String
    Caption = "Please select input Requirements file - only xlsb & xlxs files !!!"

    Dim Ret As Variant
    Ret = Application.GetOpenFilename(Filter, , Caption)

    If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub
    
      
    ' Status bar msg
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Uploading Requirements ..."
    
    Dim wb As Workbook
    Set wb = Workbooks.Open(Ret)
    

    'copy into a specific worksheet in your target workbook
    wb.Worksheets("Requirements").UsedRange.Copy targetWorkbook.Worksheets("Requirements").Range("A1")
    
    'close opened workbook without saving
    wb.Close SaveChanges:=False
          
            Sheets("Real Time Status").Range("A1:D2").Merge
            Sheets("Real Time Status").Range("A1:D2").Interior.ColorIndex = 10
            Sheets("Real Time Status").Range("A1:D2").HorizontalAlignment = xlCenter
            Sheets("Real Time Status").Range("A1:D2").VerticalAlignment = xlCenter
            Sheets("Real Time Status").Range("A1:D2").Font.ColorIndex = 1
            Sheets("Real Time Status").Range("A1:D2").Font.Name = "Arial"
            Sheets("Real Time Status").Range("A1:D2").Font.Bold = True
            Sheets("Real Time Status").Range("A1:D2").Font.Size = 11
            Sheets("Real Time Status").Range("A1:D2").Value = "Requirements uploaded"
    

    Application.ScreenUpdating = True
    
    'End Status bar
     Application.StatusBar = False
     Application.DisplayStatusBar = oldStatusBar
    
            
    Result = MsgBox("Requirements uploaded succesfully - please load Extract File", vbOKCancel + vbQuestion)
    If Result = vbOK Then
         Call Import_Extract
        Else
            ActiveWorkbook.Close
    End If

  
End Sub
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

aRandomHelper

Active Member
Joined
Jan 14, 2021
Messages
278
Office Version
  1. 2016
Platform
  1. Windows
Hi, try this amended code:

Rich (BB code):
Public Sub Import_Requirements()

    Application.ScreenUpdating = False
    
   'Get workbook...
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Application.ThisWorkbook

    ' get the customer workbook
    Dim Filter As String
    Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"

    Dim Caption As String
    Caption = "Please select input Requirements file - only xlsb & xlxs files !!!"
tryAgain:
    Dim Ret As Variant
    Ret = Application.GetOpenFilename(Filter, , Caption)

    If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub
    
      
    ' Status bar msg
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Uploading Requirements ..."
    
    Dim wb As Workbook
    Set wb = Workbooks.Open(Ret)
    
    Dim ws As Worksheet, hasSheet As Boolean
    hasSheet = False
    For Each ws In wb.Sheets
        If ws.Name = "Requirements" Then hasSheet = True
    Next
    If Not hasSheet Then
        wb.Close False
        MsgBox "The selected workbook seems to be incorrect. Please re-select."
        GoTo tryAgain
    End If

    'copy into a specific worksheet in your target workbook
    wb.Worksheets("Requirements").UsedRange.Copy targetWorkbook.Worksheets("Requirements").Range("A1")
    
    'close opened workbook without saving
    wb.Close SaveChanges:=False
          
            Sheets("Real Time Status").Range("A1:D2").Merge
            Sheets("Real Time Status").Range("A1:D2").Interior.ColorIndex = 10
            Sheets("Real Time Status").Range("A1:D2").HorizontalAlignment = xlCenter
            Sheets("Real Time Status").Range("A1:D2").VerticalAlignment = xlCenter
            Sheets("Real Time Status").Range("A1:D2").Font.ColorIndex = 1
            Sheets("Real Time Status").Range("A1:D2").Font.Name = "Arial"
            Sheets("Real Time Status").Range("A1:D2").Font.Bold = True
            Sheets("Real Time Status").Range("A1:D2").Font.Size = 11
            Sheets("Real Time Status").Range("A1:D2").Value = "Requirements uploaded"
    

    Application.ScreenUpdating = True
    
    'End Status bar
     Application.StatusBar = False
     Application.DisplayStatusBar = oldStatusBar
    
            
    Result = MsgBox("Requirements uploaded succesfully - please load Extract File", vbOKCancel + vbQuestion)
    If Result = vbOK Then
         Call Import_Extract
        Else
            ActiveWorkbook.Close
    End If

  
End Sub
 
Solution

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
Maybe
VBA Code:
Public Sub Import_Requirements()

    Application.ScreenUpdating = False

    'Get workbook...
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Application.ThisWorkbook

    ' get the customer workbook
    Dim Filter As String
    Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"

    Dim Caption As String
    Caption = "Please select input Requirements file - only xlsb & xlxs files !!!"

    Dim Ret As Variant
    Ret = Application.GetOpenFilename(Filter, , Caption)

    If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub


    ' Status bar msg
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Uploading Requirements ..."

    Dim wb As Workbook
    Set wb = Workbooks.Open(Ret)
'********************************************************************************
   
 With wb
        If Not Evaluate("ISREF('" & "DA" & "'!A1)") Then
         MsgBox "incorrect workbook "
        GoTo tryAgain
        Else
            'copy into a specific worksheet in your target workbook
            wb.Worksheets("Requirements").UsedRange.Copy targetWorkbook.Worksheets("Requirements").Range("A1")
            'close opened workbook without saving
            wb.Close SaveChanges:=False
        End If
    End With

'********************************************************************************************************



    Sheets("Real Time Status").Range("A1:D2").Merge
    Sheets("Real Time Status").Range("A1:D2").Interior.ColorIndex = 10
    Sheets("Real Time Status").Range("A1:D2").HorizontalAlignment = xlCenter
    Sheets("Real Time Status").Range("A1:D2").VerticalAlignment = xlCenter
    Sheets("Real Time Status").Range("A1:D2").Font.ColorIndex = 1
    Sheets("Real Time Status").Range("A1:D2").Font.Name = "Arial"
    Sheets("Real Time Status").Range("A1:D2").Font.Bold = True
    Sheets("Real Time Status").Range("A1:D2").Font.Size = 11
    Sheets("Real Time Status").Range("A1:D2").Value = "Requirements uploaded"


    Application.ScreenUpdating = True

    'End Status bar
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar


    Result = MsgBox("Requirements uploaded succesfully - please load Extract File", vbOKCancel + vbQuestion)
    If Result = vbOK Then
        Call Import_Extract
    Else
        ActiveWorkbook.Close
    End If


End Sub
 

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
Hi, try this amended code:

Rich (BB code):
Public Sub Import_Requirements()

    Application.ScreenUpdating = False
   
   'Get workbook...
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Application.ThisWorkbook

    ' get the customer workbook
    Dim Filter As String
    Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"

    Dim Caption As String
    Caption = "Please select input Requirements file - only xlsb & xlxs files !!!"
tryAgain:
    Dim Ret As Variant
    Ret = Application.GetOpenFilename(Filter, , Caption)

    If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub
   
     
    ' Status bar msg
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Uploading Requirements ..."
   
    Dim wb As Workbook
    Set wb = Workbooks.Open(Ret)
   
    Dim ws As Worksheet, hasSheet As Boolean
    hasSheet = False
    For Each ws In wb.Sheets
        If ws.Name = "Requirements" Then hasSheet = True
    Next
    If Not hasSheet Then
        wb.Close False
        MsgBox "The selected workbook seems to be incorrect. Please re-select."
        GoTo tryAgain
    End If

    'copy into a specific worksheet in your target workbook
    wb.Worksheets("Requirements").UsedRange.Copy targetWorkbook.Worksheets("Requirements").Range("A1")
   
    'close opened workbook without saving
    wb.Close SaveChanges:=False
         
            Sheets("Real Time Status").Range("A1:D2").Merge
            Sheets("Real Time Status").Range("A1:D2").Interior.ColorIndex = 10
            Sheets("Real Time Status").Range("A1:D2").HorizontalAlignment = xlCenter
            Sheets("Real Time Status").Range("A1:D2").VerticalAlignment = xlCenter
            Sheets("Real Time Status").Range("A1:D2").Font.ColorIndex = 1
            Sheets("Real Time Status").Range("A1:D2").Font.Name = "Arial"
            Sheets("Real Time Status").Range("A1:D2").Font.Bold = True
            Sheets("Real Time Status").Range("A1:D2").Font.Size = 11
            Sheets("Real Time Status").Range("A1:D2").Value = "Requirements uploaded"
   

    Application.ScreenUpdating = True
   
    'End Status bar
     Application.StatusBar = False
     Application.DisplayStatusBar = oldStatusBar
   
           
    Result = MsgBox("Requirements uploaded succesfully - please load Extract File", vbOKCancel + vbQuestion)
    If Result = vbOK Then
         Call Import_Extract
        Else
            ActiveWorkbook.Close
    End If

 
End Sub
It is working great :) Another lesson for me. I did know about tryAgain yet so big Thanks !!!
 

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile

ADVERTISEMENT

Maybe
VBA Code:
Public Sub Import_Requirements()

    Application.ScreenUpdating = False

    'Get workbook...
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Application.ThisWorkbook

    ' get the customer workbook
    Dim Filter As String
    Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"

    Dim Caption As String
    Caption = "Please select input Requirements file - only xlsb & xlxs files !!!"

    Dim Ret As Variant
    Ret = Application.GetOpenFilename(Filter, , Caption)

    If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub


    ' Status bar msg
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Uploading Requirements ..."

    Dim wb As Workbook
    Set wb = Workbooks.Open(Ret)
'********************************************************************************
  
With wb
        If Not Evaluate("ISREF('" & "DA" & "'!A1)") Then
         MsgBox "incorrect workbook "
        GoTo tryAgain
        Else
            'copy into a specific worksheet in your target workbook
            wb.Worksheets("Requirements").UsedRange.Copy targetWorkbook.Worksheets("Requirements").Range("A1")
            'close opened workbook without saving
            wb.Close SaveChanges:=False
        End If
    End With

'********************************************************************************************************



    Sheets("Real Time Status").Range("A1:D2").Merge
    Sheets("Real Time Status").Range("A1:D2").Interior.ColorIndex = 10
    Sheets("Real Time Status").Range("A1:D2").HorizontalAlignment = xlCenter
    Sheets("Real Time Status").Range("A1:D2").VerticalAlignment = xlCenter
    Sheets("Real Time Status").Range("A1:D2").Font.ColorIndex = 1
    Sheets("Real Time Status").Range("A1:D2").Font.Name = "Arial"
    Sheets("Real Time Status").Range("A1:D2").Font.Bold = True
    Sheets("Real Time Status").Range("A1:D2").Font.Size = 11
    Sheets("Real Time Status").Range("A1:D2").Value = "Requirements uploaded"


    Application.ScreenUpdating = True

    'End Status bar
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar


    Result = MsgBox("Requirements uploaded succesfully - please load Extract File", vbOKCancel + vbQuestion)
    If Result = vbOK Then
        Call Import_Extract
    Else
        ActiveWorkbook.Close
    End If


End Sub
Thanks Mohadin. I add tryAgain: label and it also works great. Thank you for your time and tips :)
 

radsok8199

New Member
Joined
Dec 4, 2020
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
  3. Mobile
Gents how can I get source workbook name copied and displayed as part of this code ?
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
VBA Code:
If Not Evaluate("ISREF('" & "Requirements" & "'!A1)") Then
 

Watch MrExcel Video

Forum statistics

Threads
1,129,383
Messages
5,635,942
Members
416,889
Latest member
dhegs

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
Top