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:
-
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.
-
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