Excel VBA Macro - Looping through a column of a filtered table

Question

I have a spreadsheet with a whole bunch of data (A directory of weather stations) which calculates the closest weather stations to a user entered Latitude and Longitude. This worksheet achieves this by calculating distance from the entered point, ranking those distances using SMALL() and then an excel TABLE/List with formulas perform Index(Match()) type calculations using Rankings (1 is closest, 2 is 2nd closest etc).

The worksheet whilst slow, works fairly well - and the excel Tables allow for advanced sorting of the weather station directory by various criteria (Such as length of record in years etc).

I have a VBA Macro that I was writing which used to work, but stopped working when I tried to fix it (awesome).

The purpose of the VBA Macro is to write a Google Earth KML file with the lat/long/weather station name and then to launch that file into google earth so the user can visualise the proximate stations around a set site location (the one previously entered by the user).

Unfortunately the original method I used couldn't handle the Filtered Results of the List, such that if the user filtered the results (Such that the first 4 weather stations were filtered out as an example) the macro would still write the first four weather stations that were not Visible/Were Filtered.

The problem for me is made more difficult as I wish to have only one macro for four worksheets with filter-able tables - for different data types.

At this stage the data the macro needs are stored in the Tables in identically named Table Columns: {"STATION","LONGITUDE","LATITUDE"} in different worksheets. The majority of the KML strings required to write to the KML file are stored in another hidden worksheet "KML".

The macro is launched via a button on each of these pages.

I understand that there could be a solution using ".SpecialCells(xlCellTypeVisible)" - and I've tried extensively to get it to work with my Tables - but have had no luck so far - probably due to my lack of formal training.

Any help appreciated, be it a solution or a suggestion! Apologies for my bad code, the problem loop & broken code area is about halfway down - after 'Find all table on active sheet:

Sub KML_writer()
Dim FileName As String
Dim StrA As String
Dim NumberOfKMLs
Dim MsgBoxResponse
Dim MsgBoxTitle
Dim MsgBoxPrompt
Dim WhileCounter
Dim oSh As Worksheet
    Set oSh = ActiveSheet
'Prompt the Number of Stations to Write to the KML File
NumberOfKMLs = InputBox(Prompt:="Please Enter the number of Weather Stations to generate within the Google Earth KML file", _
                Title:="Number of Weather Stations", Default:="10")
'Prompt a File Name
FileName = InputBox(Prompt:="Please Enter a name for your KML File.", _
                Title:="Lat Long to KML Converter", Default:="ENTER FILE NAME")

'Will clean this up to not require Write to Cell and Write to KML duplication later
Sheets("kml").Range("B3").Value = FileName
Sheets("mrg").Range("C5").Value = "Exported from EXCEL by AJK's MRG Function"

saveDir = "H:\" 'Local Drive available for all users of macro

targetfile = saveDir & FileName & ".KML"

'Write Site Location to KML STRING - user entered values from SITE LOCATION worksheet
StrA = Sheets("kml").Range("B1").Value & Sheets("kml").Range("B2").Value & "SITE LOCATION" & Sheets("kml").Range("B4").Value & Sheets("INPUT COORDINATES").Range("E5").Value & Sheets("kml").Range("B6").Value & Sheets("INPUT COORDINATES").Range("E4").Value & Sheets("kml").Range("B8").Value

    'Find all tables on active sheet
    Dim oLo As ListObject
    For Each oLo In oSh.ListObjects

'
        Dim lo As Excel.ListObject
        Dim lr As Excel.ListRow
        Set lo = oSh.ListObjects(oLo.Name)
        Dim cl As Range, rng As Range
        Set rng = Range(lo.ListRows(1))  'this is where it breaks currently

    For Each cl In rng2    '.SpecialCells(xlCellTypeVisible)


'Stop looping when NumberofKMLs is written to KML
            WhileCounter = 0
            Do Until WhileCounter > (NumberOfKMLs - 1)
            WhileCounter = WhileCounter + 1

                Dim St
                Dim La
                Dim Lon


                'Store the lr.Range'th station data to write to the KML
                St = Intersect(lr.Range, lo.ListColumns("STATION").Range).Value
                La = Intersect(lr.Range, lo.ListColumns("LATITUDE").Range).Value
                Lon = Intersect(lr.Range, lo.ListColumns("LONGITUDE").Range).Value


                'Write St La Long & KML Strings for Chosen Stations
                StrA = StrA & Sheets("kml").Range("B2").Value & St & Sheets("kml").Range("B4").Value & Lon & Sheets("kml").Range("B6").Value & La & Sheets("kml").Range("B8").Value

        Loop
        Next
        Next

'Write end of KML strings to KML File
StrA = StrA & Sheets("kml").Range("B9").Value

'Open, write, close KML file
Open targetfile For Output As #1
Print #1, StrA
Close #1

'Message Box for prompting the launch of the KML file
MsgBoxTitle = ("Launch KML?")
MsgBoxPrompt = "Would you like to launch the KML File saved at " & targetfile & "?" & vbCrLf & vbCrLf & "Selecting 'No' will not prevent the file from being written."
MsgBoxResponse = MsgBox(MsgBoxPrompt, vbYesNo, MsgBoxTitle)
If MsgBoxResponse = 6 Then ThisWorkbook.FollowHyperlink targetfile

End Sub 

Answer 1

Here is an example of iteration over a filtered table. This uses a ListObject table which are a little easier to work with than just a range of autofiltered cells arranged like a table, but the same general idea can be used (except you can't call on the DataBodyRange of a non-ListObject table).

Create a table:

Apply some filter(s) to it:

Notice that several rows have been hidden, and the visible rows are not necessarily contiguous, so we need to use the .Areas of the table's DataBodyRange which are visible.

As you've already surmised, you can use the .SpecialCells(xlCellTypeVisible) to do this.

Here's an example:

Sub TestFilteredTable()

   Dim tbl As ListObject
   Dim rngTable As Range
   Dim rngArea As Range
   Dim rngRow As Range

   Set tbl = ActiveSheet.ListObjects(1)
   Set rngTable = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)

   ' Here is the address of the table, filtered:
   Debug.Print "Filtered table: " & rngTable.Address

   '# Here is how you can iterate over all
   '  the areas in this filtered table:
   For Each rngArea In rngTable.Areas
      Debug.Print "  Area: " & rngArea.Address

         '# You will then have to iterate over the
         '  rows in every respective area
         For Each rngRow In rngArea.Rows
            Debug.Print "    Row: " & rngRow.Address
         Next
   Next

End Sub

Sample output:

Filtered table: $A$2:$G$2,$A$4:$G$4,$A$6:$G$6,$A$9:$G$10
  Area: $A$2:$G$2
    Row: $A$2:$G$2
  Area: $A$4:$G$4
    Row: $A$4:$G$4
  Area: $A$6:$G$6
    Row: $A$6:$G$6
  Area: $A$9:$G$10
    Row: $A$9:$G$9
    Row: $A$10:$G$10

Try and adapt this method to your problem, and if you have a specific error/issue with implementing it, let me know.
Just remember to update your original question to indicate a more specific problem :)