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

R

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

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
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
 
Upvote 0
Solution
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
 
Upvote 0
aRandomHelper said:
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
Click to expand...
It is working great :) Another lesson for me. I did know about tryAgain yet so big Thanks !!!
 
Upvote 0
mohadin said:
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
Click to expand...
Thanks Mohadin. I add tryAgain: label and it also works great. Thank you for your time and tips :)
 
Upvote 0
Gents how can I get source workbook name copied and displayed as part of this code ?
 
Upvote 0
VBA Code: 
If Not Evaluate("ISREF('" & "Requirements" & "'!A1)") Then
 
Upvote 0
You must log in or register to reply here.

Similar threads

KlausW
  • Solved
import a sheet from a closed workbook from location in cell
Replies
3
Views
332
bobsan42
bobsan42
T
  • Question Question
Automatically Copying Data To A New Workbook When Closing A Workbook
Replies
4
Views
413
Tmini
T
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
86
brentcole
B
R
  • Question Question
VBA to Copy Multiple sheets to new workbook & save as .xlsb or .xlsx
2
Replies
16
Views
2K
rahildhody
R
K
  • Solved
Using input excel cell to define sheet name in VBA code
Replies
5
Views
277
mumps
mumps

Forum statistics

Threads
1,223,693
Messages
6,173,877
Members
452,536
Latest member
Chiz511

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