Trying to loop through a list validation but receiving error

seanbarker

New Member
Joined
Apr 8, 2020
Messages
3
Platform
  1. Windows
I'm trying to collate data from several list validation cells into another workbook. I have created a seperate function to loop through any given validation cell. There are 4 cells i am trying to loop over:
1st contains a list of aircraft
2nd contains a list of countries
3rd contains a list of airports
4th contains a list of years.

The last 3 are related, as i need data from each year, for each airport in each country. My `create_list` function does the looping, and seems to work initially to create a list of all countries, all airports for the first country (i.e when the first country is selected as the target for the country list validation cell), and all years.

Once i complete a loop for a given country, i then need to re-call the `create_list` function in order to get my new list of airports for the 2nd, 3rd, 4th country etc. This is where the code fails. Here is the relevant code (comments of specific error below it):

Function that creates lists:
```
VBA Code:
Function create_list(start_cell, ByVal emissions_wb, ByRef list)
    
    Dim dropdown_list As Range
    Dim no_rows As Integer
    Dim sheet As Worksheet
    
    Set sheet = emissions_wb.Sheets("LTO emissions calculator")
    
    'get number of rows in validated list
    Dim str As String
    str = CStr(sheet.Range(start_cell).Validation.Formula1)                                            ERROR OCCURS HERE
    str = Replace(str, "=", "")
    Set dropdown_list = Range(str)
    no_rows = dropdown_list.rows.Count
    

    
    'update size of aircraft object
    ReDim list(1 To no_rows)
    
    'create list of all aircraft
    For i = 1 To no_rows
        'cells gets the current ith entry of the range object
        list(i) = dropdown_list.Cells(i, 1)
    Next i
    
   create_list = list
    
End Function
```
Main code:
```
VBA Code:
Sub getAircraftData()

' ________________ Variable Initialisation ____________________________

Dim emissions_wb As Workbook
Dim emissions_sheet As Worksheet
Dim new_sheet As Worksheet
Dim sheet As Worksheet
Dim data_wb As Workbook
Dim filepath As String
Dim filename As String

Dim rows As Integer

Dim aircraft As Variant
Dim countries As Variant
Dim airports As Variant
Dim years As Variant

'create named range which will contain the emissions and aircraft data for each aircraft
Dim emissions As Range

'array to store each aircrafts data in
Dim aircraft_data(1 To 5) As Variant


Dim aircraft_drop_down_cell_ref As String:  aircraft_drop_down_cell_ref = "F15"
Dim countries_drop_down_cell_ref As String: countries_drop_down_cell_ref = "F23"
Dim airports_drop_down_cell_ref As String: airports_drop_down_cell_ref = "F25"
Dim years_drop_down_cell_ref As String: years_drop_down_cell_ref = "F27"



Dim aircraft_drop_down_cell As Range: Set aircraft_drop_down_cell = Range("F15")
Dim countries_drop_down_cell As Range: Set countries_drop_down_cell = Range("F23")
Dim airports_drop_down_cell As Range: Set airports_drop_down_cell = Range("F25")
Dim years_drop_down_cell As Range: Set years_drop_down_cell = Range("F27")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'filepaths/names
filepath = "P:\Users\RQuincey\Public\Airport emissions tool\"
filename = "1.A.3.a Aviation - Annex 5 - LTO emissions calculator 2016.xlsm"

'set workbooks
Set emissions_wb = Workbooks.Open(filepath & filename)
Set emissions_wb = Workbooks(filename)


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set sheet = emissions_wb.Sheets(2)

'loop through each drop down cell to get all entries
aircraft = create_list(aircraft_drop_down_cell_ref, emissions_wb, aircraft)
countries = create_list(countries_drop_down_cell_ref, emissions_wb, countries)
airports = create_list(airports_drop_down_cell_ref, emissions_wb, airports)
years = create_list(years_drop_down_cell_ref, emissions_wb, years)

'array to store aircraft specific emissions data
Dim aircraft_emissions() As Variant
Set emissions = sheet.Range("AI12:AT16")

'open workbook to write data to
Set data_wb = Workbooks.Open("P:\Users\RQuincey\Public\Airport emissions tool\Emissions Calculator Data.xlsm")
Set data_wb = Workbooks("Emissions Calculator Data.xlsm")
Spacing = 12

Count = 0

'repeat to get all taxi times for every airport
For i = LBound(countries) To UBound(countries)
    countries_drop_down_cell = countries(i)
    'create unique airport list for specific country
    airports_drop_down_cell = Range("F25")
    airports = create_list(airports_drop_down_cell_ref, emissions_wb, airports)                                    ERROR OCCURS WHEN FUNCTION CALLED HERE
    Application.Calculate
    For j = LBound(airports) To UBound(airports)
        airports_drop_down_cell = airports(j)
        Application.Calculate
        For k = LBound(years) To UBound(years)
            years_drop_down_cell = years(k)
            'recalculate sheet
            Application.Calculate
            Count = Count + 1
            
            'store variables in another workbook
            data_wb.Sheets(2).Range(("D" & CStr(Count))) = years(k)
            data_wb.Sheets(2).Range(("C" & CStr(Count))) = airports(j)
            data_wb.Sheets(2).Range(("B" & CStr(Count))) = countries(i)
            data_wb.Sheets(2).Range(("E" & CStr(Count) & ":G" & CStr(Count))) = Range("W24:Y24")
            data_wb.Sheets(2).Range(("H" & CStr(Count) & ":J" & CStr(Count))) = Range("W26:Y26")
        Next k
    Next j
Next i

End Sub
```
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
The error i received is "Method 'Range of object '_Global' failed. For some reason the Validation.Formula1 returns "INDIRECT($F$23)" which refers the the countries list validation cell
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

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