message box and exit sub

O

orsm6

Well-known Member
Joined
Oct 3, 2012
Messages
515
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Re: message box and exit sub help

Post your existing macro that works.
 
Upvote 0
Re: message box and exit sub help

Simple example of how to check if a file exists.

Code: 
Sub FileCheckExample()
    Dim fname As String

    fname = "C:\Windows\notepad.exe"

If Not ExistFile(fname) Then
        MsgBox "Cannot find file " & fname, vbOKOnly Or vbExclamation
        Exit Sub
    Else
        MsgBox "File " & fname & " exists!", vbOKOnly Or vbInformation
    End If

fname = "C:\Windows\importantdocument.txt"

    If Not ExistFile(fname) Then
        MsgBox "Cannot find file " & fname, vbOKOnly Or vbExclamation
        Exit Sub
    Else
        MsgBox "File " & fname & " exists!", vbOKOnly Or vbInformation
    End If
End Sub
Code: 
 ''' Simple test for file existance, using DIR.  True if file exists
Function ExistFile(ByVal FilePath As String) As Boolean
        FilePath = Trim(FilePath)
        ExistFile = (FilePath <> "") And (Dir$(FilePath) <> "")
End Function

Alternatively
Code: 
''' 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
 
Upvote 0
Re: message box and exit sub help

here is the code i am running. it works well as i mentioned, just wanted to insert the extra bit if it is possible

Code: 
Sub runCTS()
'


'
'open the BI report
    Application.ScreenUpdating = False
    Dim varCellvalue As Long
        varCellvalue = Range("D1").Value
        Workbooks.Open "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"
        
'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
        Dim LR As Long


        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
            Dim Cell As Range
            Selection.NumberFormat = "General"
        For Each Cell In Selection
            Cell.Value = Cell.Value * 1
        Next Cell
        Application.ScreenUpdating = True


'fill formulas down
       Dim LastRow As Long
            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
 
Upvote 0
Re: message box and exit sub help

.
Hopefully this works :

Code: 
Option Explicit


Sub runCTS()
'
Dim fname As String


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


'
'open the BI report
    Application.ScreenUpdating = False
    
    Dim varCellvalue As Long
        varCellvalue = Range("D1").Value
        Workbooks.Open "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"
    
    If Not ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Sub
    Else
        
   
'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
        Dim LR As Long




        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
            Dim Cell As Range
            Selection.NumberFormat = "General"
        For Each Cell In Selection
            Cell.Value = Cell.Value * 1
        Next Cell
        Application.ScreenUpdating = True




'fill formulas down
       Dim LastRow As Long
            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 If
End Sub
 
Upvote 0
Re: message box and exit sub help

i get a compile error: variable not defined on the first line at .varCellvalue

edit: i moved the line: Dim varCellvalue as long up to beneath Dim fname as string

i now get a compile error for the text ExistFile with message Sub or Function not defined

Logit said:
.
Hopefully this works :

Code: 
Option Explicit


Sub runCTS()
'
Dim fname As String


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


'
'open the BI report
    Application.ScreenUpdating = False
    
    Dim varCellvalue As Long
        varCellvalue = Range("D1").Value
        Workbooks.Open "\\mdzausutwfnp001\Shardata\Logistics\Reports\Compliance to Schedule\BI Report Dump\" & varCellvalue & ".xlsm"
    
    If Not ExistFile(fname) Then
        MsgBox "File does not exist.", vbExclamation, "File Missing"
        Exit Sub
    Else
        
   
'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
        Dim LR As Long




        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
            Dim Cell As Range
            Selection.NumberFormat = "General"
        For Each Cell In Selection
            Cell.Value = Cell.Value * 1
        Next Cell
        Application.ScreenUpdating = True




'fill formulas down
       Dim LastRow As Long
            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 If
End Sub
Click to expand...
 
Last edited:
Upvote 0
Re: message box and exit sub help

.

Try this :


Code: 
[COLOR=#333333]Dim varCellvalue as String
[/COLOR]


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

 
Upvote 0
Re: message box and exit sub help

Hi Logit....

still get compile error: Block If Without End If
 
Last edited:
Upvote 0
Re: message box and exit sub help

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

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
 
Last edited:
Upvote 0
.
This is a functional example macro to check if a file exists on the D Drive :

Code: 
Sub FileExists()
    Dim FilePath As String
    Dim TestStr As String

    FilePath = "D:\FolderName\Sample.xlsx"

    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0
    If TestStr = "" Then
        MsgBox "File doesn't exist"
        Exit Sub
    End If
End Sub

The only difference with your scenario is a network location. It doesn't provide a Drive Letter Location. I am not familiar working with network locations. Sorry but I am at a loss here.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Can't get folder to create on desktop. When debugging it shows no errors.
2 3
Replies
24
Views
435
jolivanes
jolivanes
T
  • Solved
Open all files in a folder and run macro
Replies
3
Views
694
Trebor76
T
J
  • Question Question
Power Query - Data Refresh Error in Macro
Replies
3
Views
891
bobsan42
bobsan42
E
  • Question Question
Overflow Issue
Replies
9
Views
424
RoryA
RoryA
willow1985
  • Solved
VBA error handling - File already exists in location
Replies
9
Views
1K
NateSC
NateSC

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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