message box and exit sub

orsm6 · Nov 11, 2018

Hi all....

I was hoping to add a bit more to my current macro. It will open a file (path is hardcoded) with the filename based on the value of cell D1. it all works well, but would like to add somehow that if a filename does not exist in the path with the same value as D1 that a message box appears and then the sub is exited.

TIA for any help you can offer.

orsm6 · Nov 12, 2018

thank you for trying

rlv01 · Nov 13, 2018

Re: message box and exit sub help

orsm6 said:

i have edited the code to this.... it runs but will not exit sub if the file isn't found. and also wont show message box

Rich (BB code):

Option ExplicitSub runCTS()
'
'check for dump, if it is not there exit sub
    Dim fname As String
    Dim varCellvalue As String
   fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"

'open the BI report
    Application.ScreenUpdating = False

        varCellvalue = Range("D1").Value
        Workbooks.Open "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"

        If fname = "" Then
            MsgBox "File does not exist.", vbExclamation, "File Missing"
            Exit Sub
        End If

The first problem is that you are not actually testing for the existence of the file. Right at the top you are assigning the name of the file to the string variable fname:

Code:

fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump" & varCellvalue & ".xlsm"

Then a few lines later you have this

Code:

        If fname = "" Then
            MsgBox "File does not exist.", vbExclamation, "File Missing"
            Exit Sub
        End If

That's not testing to see if the file exists, that's testing to see if the string variable fname somehow got changed to "". Instead of the above, you need this:

Code:

    If Not FSO_ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Sub
   End If

Remember that you also have to add the code for function FSO_ExistFile (see post [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3 above[/URL]) somewhere in your code module or else you will get the "Sub or Function not defined" error. The second issue is that the the file test should come before you attempt to open the file, not after. Also, the line setting the value for fname should come after the line setting varCellvalue

Rich (BB code):

Option Explicit


Sub runCTS()
'
'check for dump, if it is not there exit sub
    Dim fname As String
    Dim varCellvalue As String


    'open the BI report
    Application.ScreenUpdating = False


    varCellvalue = Range("D1").Value
    fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"


    If Not FSO_ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Sub
    Else
        Workbooks.Open fname
    End If

TotallyConfused · Nov 13, 2018

Re: message box and exit sub help

Hello Orsm6

I’ll admit I am fairly new to VBA so what I’m about to say may be totally wrong. It seems to me, judging what you said in post #9 about the ‘IF’ statement not working, that there may be something assigned to the variable ‘fname’, which would mean the ‘IF’ statement was false and therefor would not execute. I’m wondering if perhaps even the folders were assigned to ‘fname’. Also, I'd think the line of 'fname = "\\mdzausutwfnp001\etc." should come after you assign a value to varCellvalue. To test this, try editing your ‘IF’ statement to read as follows:

Code:

If fname = “” Then

      MsgBox “File does not exist.”, vbExclamation, “File Missing”
      Exit Sub
  Else
      MsgBox fname
  End If

This will tell you what, if anything, is there, which should provide a clue as to what is causing the problem.

TotallyConfused

Edit. I see that Riv01 has posted just before me, so you can ignore this.

orsm6 · Nov 13, 2018

Re: message box and exit sub help

I am understanding what you say. but struggling with the code you say i need from the earlier post. I have tried all of the codes you gave me in various places before trying to open the file and i just get errors.

rlv01 said:
The first problem is that you are not actually testing for the existence of the file. Right at the top you are assigning the name of the file to the string variable fname:

Code:

fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump" & varCellvalue & ".xlsm"

Then a few lines later you have this

Code:

If fname = "" Then MsgBox "File does not exist.", vbExclamation, "File Missing" Exit Sub End If

That's not testing to see if the file exists, that's testing to see if the string variable fname somehow got changed to "". Instead of the above, you need this:

Code:

If Not FSO_ExistFile(fname) Then MsgBox "File does not exist.", vbExclamation, "File Missing" Exit Sub End If

Remember that you also have to add the code for function FSO_ExistFile (see post #3 above) somewhere in your code module or else you will get the "Sub or Function not defined" error. The second issue is that the the file test should come before you attempt to open the file, not after. Also, the line setting the value for fname should come after the line setting varCellvalue

Code:

Option Explicit Sub runCTS() ' 'check for dump, if it is not there exit sub Dim fname As String Dim varCellvalue As String 'open the BI report Application.ScreenUpdating = False varCellvalue = Range("D1").Value fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm" If Not FSO_ExistFile(fname) Then MsgBox "File does not exist.", vbExclamation, "File Missing" Exit Sub Else Workbooks.Open fname End If

rlv01 · Nov 13, 2018

Re: message box and exit sub help

orsm6 said:
I am understanding what you say. but struggling with the code you say i need from the earlier post. I have tried all of the codes you gave me in various places before trying to open the file and i just get errors.

I'm sorry that you are having problems. Unfortunately your response contains no information that would allow me to help you.

orsm6 · Nov 13, 2018

Re: message box and exit sub help

i am not sure where i am supposed to place the Function code
i have tried the following:

Code:

Sub runCTS()


'check for dump, if it is not there exit sub
    Dim fname As String
    Dim varCellvalue As String




    'open the BI report
    Application.ScreenUpdating = False
    
    
Function ExistFile(ByVal FilePath As String) As Boolean
        FilePath = Trim(FilePath)
        ExistFile = (FilePath <> "") And (Dir$(FilePath) <> "")
End Function






    If Not FSO_ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Function
    Else
        Workbooks.Open fname
    End If
        
    varCellvalue = Range("D1").Value
    fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"

result = Expected End Sub

Code:

Sub runCTS()


'check for dump, if it is not there exit sub
    Dim fname As String
    Dim varCellvalue As String




    'open the BI report
    Application.ScreenUpdating = False
    
    
Function FSO_ExistFile(ByVal FilePath As String) As Boolean
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    FSO_ExistFile = FSO.FileExists(Trim(FilePath))
End Function




    If Not FSO_ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Function
    Else
        Workbooks.Open fname
    End If
        
    varCellvalue = Range("D1").Value
    fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"

result = Expected End Sub

I have also tried to put code before the sub, but that doesn't work.

rlv01 said:
I'm sorry that you are having problems. Unfortunately your response contains no information that would allow me to help you.

orsm6 · Nov 13, 2018

Re: message box and exit sub help

i have now tried this. It will display the message box, but even if the file exists it still exits the sub

Code:

Option Explicit
Function FSO_ExistFile(ByVal FilePath As String) As Boolean
    Dim FSO As Object
    Dim fname As String
    Dim varCellvalue As String
    varCellvalue = Range("D1").Value
    
       
    Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO_ExistFile = FSO.FileExists(Trim(FilePath))
    If Not FSO_ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
    Exit Sub
   
    Else
        Workbooks.Open fname
    End If
    
    fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"

rlv01 said:
I'm sorry that you are having problems. Unfortunately your response contains no information that would allow me to help you.

rlv01 · Nov 13, 2018

Re: message box and exit sub help

Not tested

Code:

Option Explicit

''' Simple test for file existance using the File System Object. True if file exists
Function FSO_ExistFile(ByVal FilePath As String) As Boolean
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    FSO_ExistFile = FSO.FileExists(Trim(FilePath))
End Function

Sub runCTS()
'
    Dim fname As String
    Dim varCellvalue As Long
    Dim LastRow As Long
    Dim LR As Long
    Dim Cell As Range
    '
    'open the BI report
    Application.ScreenUpdating = False

    varCellvalue = Range("D1").Value
    fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"

    If Not FSO_ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Sub
    Else
        Workbooks.Open fname
    End If

    'select range of report to copy
    Application.ScreenUpdating = False
    Sheets("Table").Select
    With Sheets("Table")
        .Range("K16:Q1000" & .Cells(Rows.Count, 1).End(xlUp).Row).Select
    End With
    Selection.Copy

    'select CTS workbook and paste
    Windows("CTS Report Template.xlsm").Activate
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False
    Sheets("BI Report Paste").Select

    Application.DisplayAlerts = False
    Workbooks(Range("D1").Value & ".xlsm").Close True

    'Select range to convert to numbers
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Select
    End With

    'delete blank lines
    Application.ScreenUpdating = False
    For LR = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("A" & LR).Value = "" Or Left(Range("A" & LR), 1) = "`" Then
            Rows(LR).EntireRow.Delete
        End If
    Next LR

    'convert selected range to number
    On Error Resume Next
    Application.ScreenUpdating = False

    Selection.NumberFormat = "General"
    For Each Cell In Selection
        Cell.Value = Cell.Value * 1
    Next Cell
    Application.ScreenUpdating = True

    'fill formulas down
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Range("H3:M" & LastRow).FillDown

    'show ABS Compliance and filter largest to smallest
    ActiveSheet.Range("$A$2:$M$1000").AutoFilter Field:=11, Criteria1:="<=.9", _
                                                 Operator:=xlAnd
    ActiveSheet.Range("$A$2:$M$1000").AutoFilter Field:=1, Criteria1:="<>"

    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("BI Report Paste").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BI Report Paste").AutoFilter.Sort.SortFields.Add _
    Key:=Range("K2:K"), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("BI Report Paste").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("A1").Select

    Application.ScreenUpdating = False

    'clear old data from report page
    Sheets("Report").Select
    Range("B32:C50").ClearContents
    Range("E32:L50").ClearContents

    'select the SKU cells from the filtered CTS report
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With

    'paste the copied cells to the report sheet
    Sheets("Report").Select
    Range("B32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False

    'select the CTS Result cells from the filtered CTS report
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("K3:K" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With

    'paste the copied cells to the report sheet
    Sheets("Report").Select
    Range("c32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False

    'select the Description cells from the filtered CTS report
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("B3:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With

    'paste the copied cells to the report sheet
    Sheets("Report").Select
    Range("E32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False
    Range("G32").Select

    MsgBox ("CTS results will be copied to report page for you")
End Sub

orsm6 · Nov 13, 2018

Re: message box and exit sub help

Excel is truly awesome.

Your macro is almost there. it will exit the sub if no file is there.
If a file is there it opens a dialog box of the file it does find asking me to Save As.

not sure how to open it, copy the text i need and just close it again. previously it would open it, then close without alerts

thank you very much.

rlv01 said:

Not tested

Code:

Option Explicit

''' Simple test for file existance using the File System Object. True if file exists
Function FSO_ExistFile(ByVal FilePath As String) As Boolean
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    FSO_ExistFile = FSO.FileExists(Trim(FilePath))
End Function

Sub runCTS()
'
    Dim fname As String
    Dim varCellvalue As Long
    Dim LastRow As Long
    Dim LR As Long
    Dim Cell As Range
    '
    'open the BI report
    Application.ScreenUpdating = False

    varCellvalue = Range("D1").Value
    fname = "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"

    If Not FSO_ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Sub
    Else
        Workbooks.Open fname
    End If

    'select range of report to copy
    Application.ScreenUpdating = False
    Sheets("Table").Select
    With Sheets("Table")
        .Range("K16:Q1000" & .Cells(Rows.Count, 1).End(xlUp).Row).Select
    End With
    Selection.Copy

    'select CTS workbook and paste
    Windows("CTS Report Template.xlsm").Activate
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False
    Sheets("BI Report Paste").Select

    Application.DisplayAlerts = False
    Workbooks(Range("D1").Value & ".xlsm").Close True

    'Select range to convert to numbers
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Select
    End With

    'delete blank lines
    Application.ScreenUpdating = False
    For LR = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("A" & LR).Value = "" Or Left(Range("A" & LR), 1) = "`" Then
            Rows(LR).EntireRow.Delete
        End If
    Next LR

    'convert selected range to number
    On Error Resume Next
    Application.ScreenUpdating = False

    Selection.NumberFormat = "General"
    For Each Cell In Selection
        Cell.Value = Cell.Value * 1
    Next Cell
    Application.ScreenUpdating = True

    'fill formulas down
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Range("H3:M" & LastRow).FillDown

    'show ABS Compliance and filter largest to smallest
    ActiveSheet.Range("$A$2:$M$1000").AutoFilter Field:=11, Criteria1:="<=.9", _
                                                 Operator:=xlAnd
    ActiveSheet.Range("$A$2:$M$1000").AutoFilter Field:=1, Criteria1:="<>"

    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("BI Report Paste").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BI Report Paste").AutoFilter.Sort.SortFields.Add _
    Key:=Range("K2:K"), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("BI Report Paste").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("A1").Select

    Application.ScreenUpdating = False

    'clear old data from report page
    Sheets("Report").Select
    Range("B32:C50").ClearContents
    Range("E32:L50").ClearContents

    'select the SKU cells from the filtered CTS report
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With

    'paste the copied cells to the report sheet
    Sheets("Report").Select
    Range("B32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False

    'select the CTS Result cells from the filtered CTS report
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("K3:K" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With

    'paste the copied cells to the report sheet
    Sheets("Report").Select
    Range("c32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False

    'select the Description cells from the filtered CTS report
    Sheets("BI Report Paste").Select
    With Sheets("BI Report Paste")
        .Range("B3:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy
    End With

    'paste the copied cells to the report sheet
    Sheets("Report").Select
    Range("E32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                    :=False, Transpose:=False
    Range("G32").Select

    MsgBox ("CTS results will be copied to report page for you")
End Sub

orsm6 · Nov 13, 2018

Re: message box and exit sub help

ignore the Save As bit.... i managed to get this to work.

thanks again for your patience and help!!

message box and exit sub

orsm6

Well-known Member

orsm6

Well-known Member

Excel Facts

rlv01

Well-known Member

TotallyConfused

Board Regular

orsm6

Well-known Member

rlv01

Well-known Member

orsm6

Well-known Member

orsm6

Well-known Member

rlv01

Well-known Member

orsm6

Well-known Member

orsm6

Well-known Member

Similar threads

Forum statistics

Share this page

message box and exit sub

Well-known Member

Well-known Member

Excel Facts

Well-known Member

Board Regular

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock