lundi 15 mars 2021

VBA to display name of another workbook which from worksheet is uploaded & if worksheet does not exist create warning message

Below code I manage to create uploads specific worksheet with requirements from another workbook. This workbook with requrments i receive every month but name of the file get changed all the time ( Version, date etc). Once sheet is uploaded into targetWorkbook.Worksheets("Requiments") and module completed, message is being created in another sheet.

Unfortunately my knowledge of VBA is not enough to create additional changes as below:

  1. If required sheet from upload workbook does not exist ( ex: typo in sheet name, or user picked wrong workbook which does not contain required sheet) msg to pop up "It is not valid file - please check path and upload again" with option YES/Cancel where Yes will start process again and Cancel will close target workbook without saving.

  2. Once sheet is uploaded i would like receive confirmation from which workbook it has been uploaded ( name of workbook file). So user can verify if valid file has been picked. It should be displayed in worksheet "Real Time Status" next to "Requirments uploaded" message. Or use name of this workbook as part of this message ( example "Requrments1_0_12032020.xlsx uploaded")

Also all advises about do/don't about below code very welcome

Public Sub Import_REQUIRMENT()

Application.ScreenUpdating = False
    
'Gets expected sheet  from another workbook
    Dim Filter As String
    Dim Caption As String
    Dim Ret As Variant
    Dim wb As Workbook
    Dim targetWorkbook As Workbook
    Set wb = Workbooks.Open(Ret)
    Set targetWorkbook = Application.ThisWorkbook
    
    Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"
    Caption = "Please select input Requirment file - only xlsb & xlxs files !!!"
    
    Ret = Application.GetOpenFilename(Filter, , Caption)
    If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub
    
'Excel bottom status bar msg
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Uploading requrments file ..."
    
'Copy into a specific worksheet of the tool
    wb.Worksheets("REQ").UsedRange.Copy targetWorkbook.Worksheets("Requiments").Range("A1")
    
'Close opened source 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 = "Requirments uploaded"
    
    Application.ScreenUpdating = True
    
'End Excel status bar

     Application.StatusBar = False
     Application.DisplayStatusBar = oldStatusBar

            
    Result = MsgBox("Requirments file uploaded succesfully - please load Extract File", vbOKCancel + vbQuestion)
    If Result = vbOK Then
         Call Import_REQUIRMENT
        Else
            ThisWorkbook.Close SaveChanges:=False
    End If
            
            Call Import_Extract
  
End Sub

Aucun commentaire:

Enregistrer un commentaire