Loop do while multiple conditions

[Ruca13]

Hi all.

I wanna have loop that keeps "looping" as long as countif < 1, but also if the file is not found and if the vlookup returns an error.

I can do only with the first condition:

    Else
    'still need the location found but not price error handling
    MsgBox ("The location was not found - searching price in the past")
    Dim i As Integer
    i = 1
    Do While count_icao < 1
    ActiveWorkbook.Close
    Worksheets("Lookups").Cells(1, 50) = Cells(ActiveCell.Row, 18) - i
        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")
    count_icao = Application.CountIf(Columns(2), Location & "*")
    i = 1 + i
    Loop
    
    Set lk_range = Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15))
    price = Application.VLookup(Location, lk_range, 10, False)
    Workbooks(file_name).Worksheets("Rolling DB").Activate
    ActiveCell = price

The countif <1 means the value i'm searching with the vlookup does not exist in the range, so the loop opens the file from the week before until it finds the searched valued.

Here's the whole code:

Sub price()


'Notes
'Userform to choose the price if more than one location is found




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


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 0
If Mybook Is Nothing Then
MsgBox ("The file was not found - please open manually")
Exit Sub
End If


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))


'solve mismatch


Dim price As Variant


price = Application.VLookup(Location, lk_range, 10, False)


If IsError(price) Then
MsgBox ("The price is not available for that location")
ActiveWorkbook.Close
Exit Sub
End If


MsgBox price


Workbooks(file_name).Worksheets("Rolling DB").Activate
ActiveCell = price


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
    Dim lprice As Range
    Set lprice = Range(Cells(2, 10), Cells(2, 10).End(xlDown))
    MsgBox ("userform with choices")
    UserForm1.Show
    'user form - create a temporary sheet with the filtered data?
    Exit Sub
    Worksheets("temp filter").Delete
    
    Else
    'still need the location found but not price error handling
    MsgBox ("The location was not found - searching price in the past")
    Dim i As Integer
    i = 1
    Do While count_icao < 1
    ActiveWorkbook.Close
    Worksheets("Lookups").Cells(1, 50) = Cells(ActiveCell.Row, 18) - i
        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")
    count_icao = Application.CountIf(Columns(2), Location & "*")
    i = 1 + i
    Loop
    
    Set lk_range = Range(Cells(8, 2), Cells(Cells(8, 2).End(xlDown).Row, 15))
    price = Application.VLookup(Location, lk_range, 10, False)
    Workbooks(file_name).Worksheets("Rolling DB").Activate
    ActiveCell = price
        
    End If
End If


Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub

Regards.

 

[BarryL]

does the below work?

    Do While count_icao < 1
    On Error GoTo nextloop
    ActiveWorkbook.Close
    Worksheets("Lookups").Cells(1, 50) = Cells(ActiveCell.Row, 18) - i
        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")
    count_icao = Application.CountIf(Columns(2), Location & "*")
    i = 1 + i
nextloop:
    Loop

 

[Ruca13]

Unfortunately no. In fact it closes the workbook (before it only closed the workbook where it was searching, which is the idea).

In the whole code I had:

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 0
If Mybook Is Nothing Then
MsgBox ("The file was not found - please open manually")
Exit Sub
End If

If no file was found.

And:

If IsError(price) Then
MsgBox ("The price is not available for that location")
ActiveWorkbook.Close
Exit Sub
End If

If the result from vlookup was NA.

But i do not how to change that to put it inside the loop and that the loop continues until the 3 conditions are satisfied.

Thank you anyway