Stopping VBA if 3 scenarios are met

[ItalianPlatinum]

Hello - I have existing VBA that am looking to enhance currently I have 3 criteria, currently working for 1 & 3 looking to add #2:

I have #2 embedded into the VBA with another sub and currently causing issues as it doesn't stop the current VBA Test1.

1. Stopping VBA if file 1 is missing (working)
2. Stopping VBA if file 2 is missing (trying to add)
3. Stopping VBA is file 2 is empty (working)

Sub TEST1
    Dim UsdRws As Long
    Dim FilePath As String
    Dim TestStr As String
    Dim FoundFile As Boolean
    Dim rws As Long
    Dim bottomrow, lastblank As Long
    Dim lr As Long
    Dim vCols As Variant, vRows As Variant
    Dim i As Long, k As Long

FilePath = "MY Files\" & Format(Now(), "MM-DD-YY") & " " & "TEST" & ".csv"

    If FilePath <> "" Then
        TestStr = Dir$(FilePath)
        FoundFile = (TestStr <> "")
    Else
        FoundFile = False
    End If

    If FoundFile Then
    
    'OTHER CODE/Processes (i.e. copying, pasting, transfering, filtering data, inputting formulas, closing files/sheets)

Call openFile2  

        Else
    MsgBox "File is Empty"
  End If
      
    Else
        MsgBox "File 1 NOT FOUND"
    End If

Sub OpenFile2()
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
  
    sPath = "MY FILES\"      ' <<<<< change accordingly
  
    sPartial = "dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks.OpenText sPath & sFName
    Else
        MsgBox "File not found.", vbExclamation
    End If
End Sub

 

[ItalianPlatinum]

Ok this seems to now be operating with one minor thing. If file 1 is missing and file 2 is not empty it stops with file 1 is missing which is correct but leaves file 2 open. Anyway to have it close file 2 if it comes back as empty?

 

[ItalianPlatinum]

Hey Jeff not sure if you saw my post 11. Was wondering what is best way to tweak to accomplish that minor thing

 

[6StringJazzer]

Can you post the complete and latest code that you are using?

 

[ItalianPlatinum]

Option Explicit
Sub RUN  ()
    Dim UsdRws As Long
    Dim FilePath As String
    Dim TestStr As String
    Dim FoundFile As Boolean
    Dim rws As Long
    Dim bottomrow, lastblank As Long
    Dim lr As Long
    Dim vCols As Variant, vRows As Variant
    Dim i As Long, k As Long
    Dim ErrMsg As String
    
Application.ScreenUpdating = True
Application.EnableEvents = True

'Range("A" & lastblank & "A" & bottomrow).EntireRow.Delete NOT WORKING
'bottomrow = ActiveSheet.UsedRange.rows.count
'lastblank = ActiveSheet.Cells(rows.count, 1).End(xlUp).row + 1
'Range("A" & lastblank & "A" & bottomrow).EntireRow.Delete

'find path if not found give msg (NAS Fie)
    FilePath = “MY PATH") & " " & "Div" & ".csv"
    
    TestStr = Dir$(FilePath)
    
    If TestStr = "" Then
        ErrMsg = "NAS DIV File NOT FOUND"
    End If
    
'If found check if File2 Exists
    If Not OpenCopy1 Then
        ErrMsg = ErrMsg & vbCrLf & "FILE2 File NOT FOUND"
    End If

'If FILE2 found check if FILE2 file is NOT empty give msg end of VBA if Empty
If Range("A" & rows.count).End(xlUp).row <= 3 Then
      Call CLOSE2
      ErrMsg = ErrMsg & vbCrLf & "FILE2 File is Empty"
   End If
  
   If ErrMsg <> "" Then
      MsgBox ErrMsg
   Else
 
'other processes (like filters, copy, pasting, closing files, saving files, archving, clear sheets, calculating formulas

'save and close NAS Compare
Workbooks("NAS Compare").Close SaveChanges:=True
    
Application.ScreenUpdating = True
Application.EnableEvents = True
    End If
End Sub

 

[6StringJazzer]

There is not enough information in the code you have posted to this thread to diagnose the latest problem you are describing. I cannot tell from this code what is File 2 or how it is being opened, so I don't know how to close it. The Sub CLOSE2 seems to be intended to close it, and it is being called in the condition where File 2 is found to be empty, but the code for CLOSE2 is not provided so I cannot say why it's not working. (Also I don't understand the logic for determining whether the file is empty, but if you are happy with it then I don't need to know.)

Also, by the way, when providing code I suggest doing a direct copy of compiled code from VBA to paste there. This line of code has an illegal character that is typically added by Word, plus an unmatched ")":

    FilePath = “MY PATH") & " " & "Div" & ".csv"

 

[ItalianPlatinum]

Oh that is my fault i forgot the functions and other sub. see below does that help.

Function OpenCopy1() As Boolean
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
  
    sPath = "MYPATH"      ' <<<<< change accordingly
  
    sPartial = "dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks.OpenText sPath & sFName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True
        OpenCopy1 = True
    Else
        OpenCopy1 = False
    End If
End Function

Sub CLOSE2()
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
  
    sPath = "MYPATH"      ' <<<<< change accordingly
  
    sPartial = "dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks(sFName).Close SaveChanges:=False
    Else
    End If
End Sub

 

[6StringJazzer]

The file handling here is a bit hard to track. Normally I recommend that when you open a file you assign it to a Workbook object, and refer to it by that object. It seems that you are depending on which file is active at any given time, which can cause problems. It is also a little confusing to me which file is which at any given time, but I think I'm getting it.

For example,

If Range("A" & rows.count).End(xlUp).row <= 3 Then

This assumes that you are checking the active file, and you seem to assume that is File 2. However, if File 2 cannot be opened, then this line of code runs anyway, and will refer to File 1.

In addition, CLOSE2 is complicated to close an Excel file. If you do this when you open it in OpenCopy1

Dim NewWB As Workbook
Set NewWB = Workbooks.OpenText sPath & sFName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 2)), TrailingMinusNumbers:=True

Then you can close it with

NewWB.Close

instead of calling CLOSE2.


I am going to make additional recommendations but can't get to it until tomorrow.

 

[ItalianPlatinum]

Undersood Jeff. when I orignally put this together it wasnt very efficicent. So any recommendations you have would be very helpful.

 

[6StringJazzer]

OK, here is what I've got but there are a couple of holes. This code does not show where File 1 is opened. I do not know what the NAS Compare file is that is being closed. See comments in the code.

Option Explicit


Sub RUN()

    Dim UsdRws As Long
    Dim FilePath As String
    Dim TestStr As String
    Dim FoundFile As Boolean
    Dim rws As Long
    Dim bottomrow, lastblank As Long
    Dim lr As Long
    Dim vCols As Variant, vRows As Variant
    Dim i As Long, k As Long
    Dim ErrMsg As String
    Dim FILE2 As Workbook
    
   Application.ScreenUpdating = True
   Application.EnableEvents = True

'Range("A" & lastblank & "A" & bottomrow).EntireRow.Delete NOT WORKING
'bottomrow = ActiveSheet.UsedRange.rows.count
'lastblank = ActiveSheet.Cells(rows.count, 1).End(xlUp).row + 1
'Range("A" & lastblank & "A" & bottomrow).EntireRow.Delete

'find path if not found give msg (NAS Fie)
    Const BasePath = "MY PATH\"
    
    FilePath = BasePath & "Div" & ".csv"
    
    TestStr = Dir$(FilePath)
    
    If TestStr = "" Then
        ErrMsg = "NAS DIV File NOT FOUND"
    End If
    ''''''''''''''''''''' I don't see where the file at FilePath is opened or closed  ''''''''''''''''''''
    
'If found check if File2 Exists
    Set FILE2 = OpenCopy1(BasePath)
    If FILE2 Is Nothing Then
        ErrMsg = ErrMsg & vbCrLf & "FILE2 File NOT FOUND"
    Else

'If FILE2 found check if FILE2 file is NOT empty give msg end of VBA if Empty
      If FILE2.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row <= 3 Then
         FILE2.Close SaveChanges:=False
         ErrMsg = ErrMsg & vbCrLf & "FILE2 File is Empty"
      End If
   End If
   
   If ErrMsg <> "" Then
      MsgBox ErrMsg
   Else
 
      'other processes (like filters, copy, pasting, closing files, saving files, archving, clear sheets, calculating formulas
      
      FILE2.Close SaveChanges:=False
      
      'save and close NAS Compare
      ''''''''''''''''''''' I do not see where this is created/opened '''''''''''''''''''''''''''''
      Workbooks("NAS Compare").Close SaveChanges:=True
          
      Application.ScreenUpdating = True
      Application.EnableEvents = True
      
   End If
   
End Sub

Function OpenCopy1(BasePath As String) As Workbook
    Dim sPartial    As String
    Dim sFName      As String
  
    sPartial = "dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
    sFName = Dir(BasePath & sPartial)
    On Error Resume Next
    Workbooks.OpenText Filename:=BasePath & sFName, _
                       DataType:=xlDelimited, _
                       TextQualifier:=xlDoubleQuote, _
                       ConsecutiveDelimiter:=False, _
                       Tab:=False, _
                       Semicolon:=False, _
                       Comma:=True, _
                       Space:=False, _
                       Other:=False, _
                       FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 2)), _
                       TrailingMinusNumbers:=True
    Set OpenCopy1 = ActiveWorkbook
End Function

'''''''''''''''''''''''''''' This is now obsolete ''''''''''''''''''''''
Sub CLOSE2()
    Dim sPath       As String
    Dim sPartial    As String
    Dim sFName      As String
  
    sPath = "MYPATH"      ' <<<<< change accordingly
  
    sPartial = "dist_" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.txt"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks(sFName).Close SaveChanges:=False
    Else
    End If
End Sub

 

[ItalianPlatinum]

it is embedded in the other processes section i had if you want to see it I pasted below the section where its called out.

'copy and paste NAS file into NAS DIV sheet in NAS Compare
Workbooks.Open Filename:="MY PATH\" & Format(Now(), "MM-DD-YY") & " " & "Div" & ".csv"
Cells.Copy

With Workbooks("Nas Compare").Sheets("NAS DIV")
    .Range("A1").PasteSpecial
    .Range("5:5").AutoFilter
    .Protect AllowFormattingColumns:=True, DrawingObjects:=True, Contents:=True, AllowFiltering:=True
End With

'Close NAS File
Workbooks.Open Filename:="MY PATH\" & Format(Now(), "MM-DD-YY") & " " & "Div" & ".csv"
ActiveWorkbook.Close