Hello everyone.
Does anyone know if it's possible to make a macro continue only after opening another file, and if so, how to do it?
The idea is that when the explorer opens the folder (this part works), i open a chosen file, and only then the macro continues.
Here's my code (don't worry about the userform):
After the shell, i should open a file, and instead of the loop (i kept it there so far for you guys to get the idea of what was being done), it should simply continue as if it was the correct file, and so , do the lk_range and price and sup, but i believe I can do this part, should not be different from before.
I hope the idea is understandable because I was unable to formulate well enough while surfing the web.
Thank you.
Does anyone know if it's possible to make a macro continue only after opening another file, and if so, how to do it?
The idea is that when the explorer opens the folder (this part works), i open a chosen file, and only then the macro continues.
Here's my code (don't worry about the userform):
Code:
Sub price()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationAutomatic
file_name = Worksheets("Settings").Cells(1, 5).Value
price_path = Worksheets("Settings").Cells(1, 11).Value
Location = Cells(ActiveCell.Row, 16).Value
Dim file As Workbook
Set file = ActiveWorkbook
If ActiveCell.Column = 11 Then
If (ActiveCell.Row < 3 Or Application.CountA(ActiveCell.EntireRow) = 0) Then
MsgBox "Please select a cell from the price column"
Exit Sub
End If
Else
MsgBox "Please select a cell from the price column"
Exit Sub
End If
Worksheets("Lookups").Cells(1, 50) = Cells(ActiveCell.Row, 18)
On Error Resume Next
Dim Mybook As Workbook
'ex: \2016\01 January 2016/FPI 01 Jan 2016.xlsx
Set Mybook = Workbooks.Open(price_path & Worksheets("Lookups").Cells(1, 54).Value & "\" & _
Worksheets("Lookups").Cells(1, 53).Text & " " & Worksheets("Lookups").Cells(1, 56).Text & " " & _
Worksheets("Lookups").Cells(1, 54).Text & "/FPI " & Worksheets("Lookups").Cells(1, 52).Text & " " & _
Worksheets("Lookups").Cells(1, 55).Text & " " & Worksheets("Lookups").Cells(1, 54).Text & ".xlsx")
On Error GoTo next_loop
Dim lk_range As Range
'must make location* to search only the location at left
count_icao = Application.CountIf(Columns(2), Location & "*")
If count_icao = 1 Then
Set lk_range = Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15))
Dim price As Variant
Dim sup As Variant
price = Application.VLookup(Location, lk_range, 10, False)
sup = Application.VLookup(Location, lk_range, 12, False)
If IsError(price) Then
MsgBox ("The price is not available for that location")
ActiveWorkbook.Close
Exit Sub
End If
Workbooks(file_name).ActiveSheet.Activate
ActiveCell = price
Cells(ActiveCell.Row, 12) = sup
Mybook.Close
Else
If count_icao > 1 Then
ActiveSheet.Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15)).AutoFilter Field:=1, Criteria1:=(Location)
Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15)).Copy
Workbooks(file_name).Activate
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "temp filter"
Worksheets("temp filter").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
UserForm1.Show
Workbooks(file_name).Worksheets("temp filter").Delete
Mybook.Close
Exit Sub
Else
MsgBox ("The location was not found - searching price in the past")
file.Activate
Shell "explorer.exe " & price_path & Worksheets("Lookups").Cells(1, 54).Value & "\" & _
Worksheets("Lookups").Cells(1, 53).Text & " " & Worksheets("Lookups").Cells(1, 56).Text & " " & _
Worksheets("Lookups").Cells(1, 54).Text, vbNormalFocus
Dim i As Integer
i = 1
Do While count_icao < 1
If ActiveWorkbook.Name <> file_name Then
ActiveWorkbook.Close
End If
Worksheets("Lookups").Cells(1, 50) = Cells(ActiveCell.Row, 18) - i
On Error Resume Next
Set Mybook = Workbooks.Open(price_path & Worksheets("Lookups").Cells(1, 54).Value & "\" & _
Worksheets("Lookups").Cells(1, 53).Text & " " & Worksheets("Lookups").Cells(1, 56).Text & " " & _
Worksheets("Lookups").Cells(1, 54).Text & "/FPI " & Worksheets("Lookups").Cells(1, 52).Text & " " & _
Worksheets("Lookups").Cells(1, 55).Text & " " & Worksheets("Lookups").Cells(1, 54).Text & ".xlsx")
On Error GoTo next_loop
count_icao = Application.CountIf(Columns(2), Location & "*")
i = 1 + i
next_loop:
Loop
Mybook.Activate
If count_icao > 1 Then
ActiveSheet.Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15)).AutoFilter Field:=1, Criteria1:=(Location)
Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15)).Copy
Workbooks(file_name).Activate
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "temp filter"
Worksheets("temp filter").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
UserForm1.Show
Workbooks(file_name).Worksheets("temp filter").Delete
Mybook.Close
Exit Sub
Else
Set lk_range = Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15))
price = Application.VLookup(Location, lk_range, 10, False)
sup = Application.VLookup(Location, lk_range, 12, False)
If IsError(price) Then
MsgBox ("The price is not available for that location")
Mybook.Close
Exit Sub
End If
Workbooks(file_name).Worksheets("Rolling DB").Activate
MsgBox ("Information found in file " & Mybook.Name)
ActiveCell = price
Cells(ActiveCell.Row, 12) = sup
Mybook.Close
End If
End If
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub
I hope the idea is understandable because I was unable to formulate well enough while surfing the web.
Thank you.