Im looking to stop a Macro if an external source workbook is opened

[ReignEternal]

Hello,

I have a unique situation. For ease of confusion, I will use file 1 and file 2. When I have file one open, there is a series of macros (posted below) that is supposed to work their magic to create a purchase order. In essence, file 1 reaches out to file 2, creates a folder to store the PO that gets created, then transposes the data from file 1 into the proper cells in file 2 (there's way more behind the scenes but that's the general concept). Here is the problem. If by any chance, file 2 is open, a folder gets created as intended but the PO doesn't and when I go to delete, lets call it folder 1, the folder can't be deleted because the computer/server states the folder doesn't exist.

What I am trying to find is if there is a way to prevent a macro from running if file 2 is open by, essentially, anyone else.

Here is the current macros that work perfectly (If file 2 is not open). ***I am not sure why all of the extra empty lines are showing up in the macros below***

Sub iconPOx_folder()

Call openPOx_folder(ActiveWorkbook.Path, Cells(ActiveCell.Row, colPO), Cells(ActiveCell.Row, colManf), False)

End Sub



Sub openPOx_folder(dir As String, po As String, manf As String, silent As Boolean)

'open the folder for a specific PO --or-- offer to create it if it doesn't exist.



On Error GoTo err



Dim dirPO As String



dirPO = findFolder(po, dir & "\Project POs")



If FileFolderExists(dirPO) And Len(dirPO) > 0 Then

Shell "explorer.exe """ & dirPO & "", vbNormalFocus

'Debug.Print "FileOrFolderExists:=" & dirPO

Else

dirPO = dir & "\Project POs\" & po & " " & manf & "\"

If silent = False Then Result = MsgBox("Directory doesn't Exist: Would you like to create it?", vbYesNo, "Create Directory: " & dirPO)

If Result = vbYes Or silent = True Then Call createPO(dir, po, manf, silent)

End If



err:

If err.Number = 0 Then Exit Sub

Debug.Print "openPOx_folder Error:" & err.Number & " - " & err.Description



End Sub



Sub createPO(dir As String, po As String, manf As String, silent As Boolean)



On Error GoTo err



Dim dirPO As String

Dim filePO As String

Dim wbPO As Workbook

Dim shPO As Worksheet

Dim fileTemplatePO As String



po = Trim(po)

manf = Trim(manf)



dirPO = dir & "\Project POs\" & po & " " & manf & "\"

filePO = dirPO & po & " " & manf & ".xlsm"

fileTemplatePO = Sheets("Settings").Cells(20, 2).Text



If Not FileFolderExists(dir & "\Project POs") Then

MkDir (dir & "\Project POs")

End If



MkDir (dirPO)

FileCopy fileTemplatePO, filePO



If silent = False Then r = MsgBox("Would you like to auto-populate the data?", vbYesNo, "Auto-Populate Data?")

If r = vbYes Or silent = True Then Call fillPOData(po, filePO)



err:

If err.Number = 0 Then Exit Sub

Debug.Print "Error:" & err.Number & " - " & err.Description

Set t = Nothing



End Sub



Sub fillPOData(po As String, filePO As String)

'copy the excel template PO spreadsheet and populate it with data



On Error GoTo err



Dim wb1 As Workbook

Dim shMOS As Worksheet

Dim shTemp As Worksheet

Dim sRng As String

Dim rng As Range

Dim intArray As Variant, i As Integer



Dim wbPO As Workbook

Dim shPO As Worksheet



Application.ScreenUpdating = False



Set wb1 = ActiveWorkbook

Set shMOS = ActiveWorkbook.Sheets("Material Ordering")



'po = ActiveCell.Text

L = shMOS.AutoFilter.Range.Rows.Count

sRng = shMOS.AutoFilter.Range.Address



'--- Create new sheet for temporary use to summarize

Set shTemp = Sheets.Add(After:=ActiveSheet)

shTemp.Range(sRng).Offset(-9, 0).Value = shMOS.AutoFilter.Range.Value

shTemp.Range("A:D").EntireColumn.Delete

shTemp.Range("E:E").EntireColumn.Value = ""



'--- filter new sheet and remove other lines

shTemp.Range("A1:S" & L).AutoFilter Field:=19, Criteria1:="<>" & po

shTemp.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)

shTemp.AutoFilter.Range.AutoFilter Field:=19



shTemp.Range("A1:S" & L).AutoFilter Field:=1, Criteria1:="0"

shTemp.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)

shTemp.AutoFilter.Range.AutoFilter Field:=19



'--- setup formulas and remove extra columns

Set rng = Application.Intersect(shTemp.Range("N:N"), shTemp.AutoFilter.Range).Offset(1, 0).Resize(shTemp.AutoFilter.Range.Rows.Count - 1)

rng.FormulaR1C1 = "=SUMIF(R2C3:R" & L & "C3,RC3,R2C1:R" & L & "C1)"

rng.Offset(0, -13).Value = rng.Value

shTemp.Range("F:L,N:AH").EntireColumn.Delete



'--- remove duplicate rows

Set rng = shTemp.AutoFilter.Range

With rng

ReDim intArray(0 To .Columns.Count - 1)

For i = 0 To UBound(intArray)

intArray(i) = i + 1

Next i

'.RemoveDuplicates Columns:=(intArray), Header:=xlYes

.RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes

End With



'--- remove special characters that cause issues on import to GP

For Each c In shTemp.AutoFilter.Range

c.Value = Application.WorksheetFunction.Clean(c.Value)

Next c



'--- open PO workbook and populate

Set wbPO = Workbooks.Open(filePO)

Set shPO = wbPO.Sheets(1)



shPO.Range("B26").Resize(rng.Rows.Count - 1, rng.Columns.Count).Value = rng.Offset(1, 0).Value

shPO.Range("C3").Value = shMOS.Range("F3").Value

shPO.Range("C7").Value = Right(po, 2)



Application.DisplayAlerts = False

shTemp.Delete

shMOS.Activate

Application.DisplayAlerts = True



'wbPO.Close savechanges:=True

wbPO.Activate



Set shMOS = Nothing

Set shTemp = Nothing

Set sh2 = Nothing

Set wb1 = Nothing

Set wb2 = Nothing



err:

Set shMOS = Nothing

Set shTemp = Nothing

Set sh2 = Nothing

Set wb1 = Nothing

Set wb2 = Nothing



Application.ScreenUpdating = True



If err.Number = 0 Then Exit Sub

Debug.Print "fillPOData Error:" & err.Number & " - " & err.Description

End Sub